home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / db.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  144.1 KB  |  5,632 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Core Database                                   }
  6. {                                                       }
  7. {       Copyright (c) 1995,97 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Db;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Graphics;
  18.  
  19. const
  20.  
  21. { TDataSet maximum number of record buffers }
  22.  
  23.   dsMaxBufferCount = MAXINT div 8;
  24.  
  25. { Maximum string field size }
  26.  
  27.   dsMaxStringSize = 8192;
  28.  
  29. type
  30.  
  31. { Misc Dataset types }
  32.  
  33.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  34.     dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
  35.  
  36.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  37.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  38.     deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
  39.  
  40.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  41.  
  42. { Forward declarations }
  43.  
  44.   TFieldDef = class;
  45.   TFieldDefs = class;
  46.   TField = class;
  47.   TDataLink = class;
  48.   TDataSource = class;
  49.   TDataSet = class;
  50.  
  51. { Exception classes }
  52.  
  53.   EDatabaseError = class(Exception);
  54.  
  55. { TFieldDef }
  56.  
  57.   TFieldClass = class of TField;
  58.  
  59.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  60.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  61.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  62.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  63.  
  64.   TFieldDef = class
  65.   private
  66.     FOwner: TFieldDefs;
  67.     FName: string;
  68.     FDataType: TFieldType;
  69.     FRequired: Boolean;
  70.     FInternalCalcField: Boolean;
  71.     FSize: Word;
  72.     FFieldNo: Integer;
  73.     function GetFieldClass: TFieldClass;
  74.   public
  75.     constructor Create(Owner: TFieldDefs; const Name: string;
  76.       DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  77.     destructor Destroy; override;
  78.     function CreateField(Owner: TComponent): TField;
  79.     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  80.     property DataType: TFieldType read FDataType;
  81.     property FieldClass: TFieldClass read GetFieldClass;
  82.     property FieldNo: Integer read FFieldNo;
  83.     property Name: string read FName;
  84.     property Required: Boolean read FRequired;
  85.     property Size: Word read FSize;
  86.   end;
  87.  
  88. { TFieldDefs }
  89.  
  90.   TFieldDefs = class
  91.   private
  92.     FDataSet: TDataSet;
  93.     FItems: TList;
  94.     FUpdated: Boolean;
  95.     function GetCount: Integer;
  96.     function GetItem(Index: Integer): TFieldDef;
  97.   public
  98.     constructor Create(DataSet: TDataSet);
  99.     destructor Destroy; override;
  100.     procedure Add(const Name: string; DataType: TFieldType; Size: Word;
  101.       Required: Boolean);
  102.     procedure Assign(FieldDefs: TFieldDefs);
  103.     procedure Clear;
  104.     function Find(const Name: string): TFieldDef;
  105.     function IndexOf(const Name: string): Integer;
  106.     procedure Update;
  107.     property Count: Integer read GetCount;
  108.     property Items[Index: Integer]: TFieldDef read GetItem; default;
  109.   end;
  110.  
  111. { TField }
  112.  
  113.   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  114.  
  115.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  116.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  117.     DisplayText: Boolean) of object;
  118.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  119.   TFieldRef = ^TField;
  120.   TFieldChars = set of Char;
  121.  
  122.   PLookupListEntry = ^TLookupListEntry;
  123.   TLookupListEntry = record
  124.     Key: Variant;
  125.     Value: Variant;
  126.   end;
  127.  
  128.   TLookupList = class(TObject)
  129.   private
  130.     FList: TList;
  131.   public
  132.     constructor Create;
  133.     destructor Destroy; override;
  134.     procedure Add(const AKey, AValue: Variant);
  135.     procedure Clear;
  136.     function ValueOfKey(const AKey: Variant): Variant;
  137.   end;
  138.  
  139.   TField = class(TComponent)
  140.   private
  141.     FDataSet: TDataSet;
  142.     FFieldName: string;
  143.     FDataType: TFieldType;
  144.     FReadOnly: Boolean;
  145.     FFieldKind: TFieldKind;
  146.     FAlignment: TAlignment;
  147.     FVisible: Boolean;
  148.     FRequired: Boolean;
  149.     FValidating: Boolean;
  150.     FSize: Word;
  151.     FOffset: Word;
  152.     FFieldNo: Integer;
  153.     FDisplayWidth: Integer;
  154.     FDisplayLabel: string;
  155.     FEditMask: string;
  156.     FValueBuffer: Pointer;
  157.     FLookupDataSet: TDataSet;
  158.     FKeyFields: string;
  159.     FLookupKeyFields: string;
  160.     FLookupResultField: string;
  161.     FLookupCache: Boolean;
  162.     FLookupList: TLookupList;
  163.     FAttributeSet: string;
  164.     FCustomConstraint: string;
  165.     FImportedConstraint: string;
  166.     FConstraintErrorMessage: string;
  167.     FDefaultExpression: string;
  168.     FOrigin: string;
  169.     FValidChars: TFieldChars;
  170.     FOnChange: TFieldNotifyEvent;
  171.     FOnValidate: TFieldNotifyEvent;
  172.     FOnGetText: TFieldGetTextEvent;
  173.     FOnSetText: TFieldSetTextEvent;
  174.     procedure Bind(Binding: Boolean);
  175.     procedure CalcLookupValue;
  176.     function GetCalculated: Boolean;
  177.     function GetDisplayLabel: string;
  178.     function GetDisplayName: string;
  179.     function GetDisplayText: string;
  180.     function GetDisplayWidth: Integer;
  181.     function GetEditText: string;
  182.     function GetHasConstraints: Boolean;
  183.     function GetIndex: Integer;
  184.     function GetIsIndexField: Boolean;
  185.     function GetLookup: Boolean;
  186.     function GetLookupList: TLookupList;
  187.     function GetCurValue: Variant;
  188.     function GetNewValue: Variant;
  189.     function GetOldValue: Variant;
  190.     function IsDisplayLabelStored: Boolean;
  191.     function IsDisplayWidthStored: Boolean;
  192.     procedure ReadAttributeSet(Reader: TReader);
  193.     procedure ReadCalculated(Reader: TReader);
  194.     procedure ReadLookup(Reader: TReader);
  195.     procedure SetAlignment(Value: TAlignment);
  196.     procedure SetCalculated(Value: Boolean);
  197.     procedure SetDataSet(ADataSet: TDataSet);
  198.     procedure SetDisplayLabel(Value: string);
  199.     procedure SetDisplayWidth(Value: Integer);
  200.     procedure SetEditMask(const Value: string);
  201.     procedure SetEditText(const Value: string);
  202.     procedure SetFieldKind(Value: TFieldKind);
  203.     procedure SetFieldName(const Value: string);
  204.     procedure SetIndex(Value: Integer);
  205.     procedure SetLookup(Value: Boolean);
  206.     procedure SetLookupDataSet(Value: TDataSet);
  207.     procedure SetLookupKeyFields(const Value: string);
  208.     procedure SetLookupResultField(const Value: string);
  209.     procedure SetKeyFields(const Value: string);
  210.     procedure SetLookupCache(const Value: Boolean);
  211.     procedure SetNewValue(const Value: Variant);
  212.     procedure SetVisible(Value: Boolean);
  213.     procedure ValidateLookupInfo(All: Boolean);
  214.     procedure WriteAttributeSet(Writer: TWriter);
  215.   protected
  216.     function AccessError(const TypeName: string): EDatabaseError; dynamic;
  217.     procedure CheckInactive;
  218.     class procedure CheckTypeSize(Value: Integer); virtual;
  219.     procedure Change; virtual;
  220.     procedure DataChanged;
  221.     procedure DefineProperties(Filer: TFiler); override;
  222.     procedure FreeBuffers; virtual;
  223.     function GetAsBoolean: Boolean; virtual;
  224.     function GetAsCurrency: Currency; virtual;
  225.     function GetAsDateTime: TDateTime; virtual;
  226.     function GetAsFloat: Double; virtual;
  227.     function GetAsInteger: Longint; virtual;
  228.     function GetAsString: string; virtual;
  229.     function GetAsVariant: Variant; virtual;
  230.     function GetCanModify: Boolean; virtual;
  231.     function GetDataSize: Word; virtual;
  232.     function GetDefaultWidth: Integer; virtual;
  233.     function GetIsNull: Boolean; virtual;
  234.     function GetParentComponent: TComponent; override;
  235.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  236.     function HasParent: Boolean; override;
  237.     procedure Notification(AComponent: TComponent;
  238.       Operation: TOperation); override;
  239.     procedure PropertyChanged(LayoutAffected: Boolean);
  240.     procedure ReadState(Reader: TReader); override;
  241.     procedure SetAsBoolean(Value: Boolean); virtual;
  242.     procedure SetAsCurrency(Value: Currency); virtual;
  243.     procedure SetAsDateTime(Value: TDateTime); virtual;
  244.     procedure SetAsFloat(Value: Double); virtual;
  245.     procedure SetAsInteger(Value: Longint); virtual;
  246.     procedure SetAsString(const Value: string); virtual;
  247.     procedure SetAsVariant(const Value: Variant); virtual;
  248.     procedure SetDataType(Value: TFieldType);
  249.     procedure SetSize(Value: Word); virtual;
  250.     procedure SetParentComponent(AParent: TComponent); override;
  251.     procedure SetText(const Value: string); virtual;
  252.     procedure SetVarValue(const Value: Variant); virtual;
  253.   public
  254.     constructor Create(AOwner: TComponent); override;
  255.     destructor Destroy; override;
  256.     procedure Assign(Source: TPersistent); override;
  257.     procedure AssignValue(const Value: TVarRec);
  258.     procedure Clear; virtual;
  259.     procedure FocusControl;
  260.     function GetData(Buffer: Pointer): Boolean;
  261.     class function IsBlob: Boolean; virtual;
  262.     function IsValidChar(InputChar: Char): Boolean; virtual;
  263.     procedure RefreshLookupList;
  264.     procedure SetData(Buffer: Pointer);
  265.     procedure SetFieldType(Value: TFieldType); virtual;
  266.     procedure Validate(Buffer: Pointer);
  267.     property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  268.     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
  269.     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  270.     property AsFloat: Double read GetAsFloat write SetAsFloat;
  271.     property AsInteger: Longint read GetAsInteger write SetAsInteger;
  272.     property AsString: string read GetAsString write SetAsString;
  273.     property AsVariant: Variant read GetAsVariant write SetAsVariant;
  274.     property AttributeSet: string read FAttributeSet write FAttributeSet;
  275.     property Calculated: Boolean read GetCalculated write SetCalculated default False;
  276.     property CanModify: Boolean read GetCanModify;
  277.     property CurValue: Variant read GetCurValue;
  278.     property DataSet: TDataSet read FDataSet write SetDataSet stored False;
  279.     property DataSize: Word read GetDataSize;
  280.     property DataType: TFieldType read FDataType;
  281.     property DisplayName: string read GetDisplayName;
  282.     property DisplayText: string read GetDisplayText;
  283.     property EditMask: string read FEditMask write SetEditMask;
  284.     property EditMaskPtr: string read FEditMask;
  285.     property FieldNo: Integer read FFieldNo;
  286.     property IsIndexField: Boolean read GetIsIndexField;
  287.     property IsNull: Boolean read GetIsNull;
  288.     property Lookup: Boolean read GetLookup write SetLookup;
  289.     property LookupList: TLookupList read GetLookupList;
  290.     property NewValue: Variant read GetNewValue write SetNewValue;
  291.     property Offset: word read FOffset;
  292.     property OldValue: Variant read GetOldValue;
  293.     property Size: Word read FSize write SetSize;
  294.     property Text: string read GetEditText write SetEditText;
  295.     property ValidChars: TFieldChars read FValidChars write FValidChars;
  296.     property Value: Variant read GetAsVariant write SetAsVariant;
  297.   published
  298.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  299.     property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  300.     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  301.     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  302.     property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel
  303.       stored IsDisplayLabelStored;
  304.     property DisplayWidth: Integer read GetDisplayWidth write SetDisplayWidth
  305.       stored IsDisplayWidthStored;
  306.     property FieldKind: TFieldKind read FFieldKind write SetFieldKind default fkData;
  307.     property FieldName: string read FFieldName write SetFieldName;
  308.     property HasConstraints: Boolean read GetHasConstraints;
  309.     property Index: Integer read GetIndex write SetIndex stored False;
  310.     property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  311.     property LookupDataSet: TDataSet read FLookupDataSet write SetLookupDataSet;
  312.     property LookupKeyFields: string read FLookupKeyFields write SetLookupKeyFields;
  313.     property LookupResultField: string read FLookupResultField write SetLookupResultField;
  314.     property KeyFields: string read FKeyFields write SetKeyFields;
  315.     property LookupCache: Boolean read FLookupCache write SetLookupCache default False;
  316.     property Origin: string read FOrigin write FOrigin;
  317.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  318.     property Required: Boolean read FRequired write FRequired default False;
  319.     property Visible: Boolean read FVisible write SetVisible default True;
  320.     property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  321.     property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  322.     property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  323.     property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  324.   end;
  325.  
  326. { TStringField }
  327.  
  328.   TStringField = class(TField)
  329.   private
  330.     FTransliterate: Boolean;
  331.   protected
  332.     class procedure CheckTypeSize(Value: Integer); override;
  333.     function GetAsBoolean: Boolean; override;
  334.     function GetAsDateTime: TDateTime; override;
  335.     function GetAsFloat: Double; override;
  336.     function GetAsInteger: Longint; override;
  337.     function GetAsString: string; override;
  338.     function GetAsVariant: Variant; override;
  339.     function GetDataSize: Word; override;
  340.     function GetDefaultWidth: Integer; override;
  341.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  342.     function GetValue(var Value: string): Boolean;
  343.     procedure SetAsBoolean(Value: Boolean); override;
  344.     procedure SetAsDateTime(Value: TDateTime); override;
  345.     procedure SetAsFloat(Value: Double); override;
  346.     procedure SetAsInteger(Value: Longint); override;
  347.     procedure SetAsString(const Value: string); override;
  348.     procedure SetVarValue(const Value: Variant); override;
  349.   public
  350.     constructor Create(AOwner: TComponent); override;
  351.     property Value: string read GetAsString write SetAsString;
  352.   published
  353.     property EditMask;
  354.     property Size default 20;
  355.     property Transliterate: Boolean read FTransliterate write FTransliterate default True;
  356.   end;
  357.  
  358. { TNumericField }
  359.  
  360.   TNumericField = class(TField)
  361.   private
  362.     FDisplayFormat: string;
  363.     FEditFormat: string;
  364.   protected
  365.     procedure RangeError(Value, Min, Max: Extended);
  366.     procedure SetDisplayFormat(const Value: string);
  367.     procedure SetEditFormat(const Value: string);
  368.   public
  369.     constructor Create(AOwner: TComponent); override;
  370.   published
  371.     property Alignment default taRightJustify;
  372.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  373.     property EditFormat: string read FEditFormat write SetEditFormat;
  374.   end;
  375.  
  376. { TIntegerField }
  377.  
  378.   TIntegerField = class(TNumericField)
  379.   private
  380.     FMinRange: Longint;
  381.     FMaxRange: Longint;
  382.     FMinValue: Longint;
  383.     FMaxValue: Longint;
  384.     procedure CheckRange(Value, Min, Max: Longint);
  385.     procedure SetMaxValue(Value: Longint);
  386.     procedure SetMinValue(Value: Longint);
  387.   protected
  388.     function GetAsFloat: Double; override;
  389.     function GetAsInteger: Longint; override;
  390.     function GetAsString: string; override;
  391.     function GetAsVariant: Variant; override;
  392.     function GetDataSize: Word; override;
  393.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  394.     function GetValue(var Value: Longint): Boolean;
  395.     procedure SetAsFloat(Value: Double); override;
  396.     procedure SetAsInteger(Value: Longint); override;
  397.     procedure SetAsString(const Value: string); override;
  398.     procedure SetVarValue(const Value: Variant); override;
  399.   public
  400.     constructor Create(AOwner: TComponent); override;
  401.     property Value: Longint read GetAsInteger write SetAsInteger;
  402.   published
  403.     property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  404.     property MinValue: Longint read FMinValue write SetMinValue default 0;
  405.   end;
  406.  
  407. { TSmallintField }
  408.  
  409.   TSmallintField = class(TIntegerField)
  410.   protected
  411.     function GetDataSize: Word; override;
  412.   public
  413.     constructor Create(AOwner: TComponent); override;
  414.   end;
  415.  
  416. { TWordField }
  417.  
  418.   TWordField = class(TIntegerField)
  419.   protected
  420.     function GetDataSize: Word; override;
  421.   public
  422.     constructor Create(AOwner: TComponent); override;
  423.   end;
  424.  
  425. { TAutoIncField }
  426.  
  427.   TAutoIncField = class(TIntegerField)
  428.   public
  429.     constructor Create(AOwner: TComponent); override;
  430.   end;
  431.  
  432. { TFloatField }
  433.  
  434.   TFloatField = class(TNumericField)
  435.   private
  436.     FCurrency: Boolean;
  437.     FCheckRange: Boolean;
  438.     FPrecision: Integer;
  439.     FMinValue: Double;
  440.     FMaxValue: Double;
  441.     procedure SetCurrency(Value: Boolean);
  442.     procedure SetMaxValue(Value: Double);
  443.     procedure SetMinValue(Value: Double);
  444.     procedure SetPrecision(Value: Integer);
  445.     procedure UpdateCheckRange;
  446.   protected
  447.     function GetAsFloat: Double; override;
  448.     function GetAsInteger: Longint; override;
  449.     function GetAsString: string; override;
  450.     function GetAsVariant: Variant; override;
  451.     function GetDataSize: Word; override;
  452.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  453.     procedure SetAsFloat(Value: Double); override;
  454.     procedure SetAsInteger(Value: Longint); override;
  455.     procedure SetAsString(const Value: string); override;
  456.     procedure SetVarValue(const Value: Variant); override;
  457.   public
  458.     constructor Create(AOwner: TComponent); override;
  459.     property Value: Double read GetAsFloat write SetAsFloat;
  460.   published
  461.     property Currency: Boolean read FCurrency write SetCurrency default False;
  462.     property MaxValue: Double read FMaxValue write SetMaxValue;
  463.     property MinValue: Double read FMinValue write SetMinValue;
  464.     property Precision: Integer read FPrecision write SetPrecision default 15;
  465.   end;
  466.  
  467. { TCurrencyField }
  468.  
  469.   TCurrencyField = class(TFloatField)
  470.   public
  471.     constructor Create(AOwner: TComponent); override;
  472.   published
  473.     property Currency default True;
  474.   end;
  475.  
  476. { TBooleanField }
  477.  
  478.   TBooleanField = class(TField)
  479.   private
  480.     FDisplayValues: string;
  481.     FTextValues: array[Boolean] of string;
  482.     procedure LoadTextValues;
  483.     procedure SetDisplayValues(const Value: string);
  484.   protected
  485.     function GetAsBoolean: Boolean; override;
  486.     function GetAsString: string; override;
  487.     function GetAsVariant: Variant; override;
  488.     function GetDataSize: Word; override;
  489.     function GetDefaultWidth: Integer; override;
  490.     procedure SetAsBoolean(Value: Boolean); override;
  491.     procedure SetAsString(const Value: string); override;
  492.     procedure SetVarValue(const Value: Variant); override;
  493.   public
  494.     constructor Create(AOwner: TComponent); override;
  495.     property Value: Boolean read GetAsBoolean write SetAsBoolean;
  496.   published
  497.     property DisplayValues: string read FDisplayValues write SetDisplayValues;
  498.   end;
  499.  
  500. { TDateTimeField }
  501.  
  502.   TDateTimeField = class(TField)
  503.   private
  504.     FDisplayFormat: string;
  505.     function GetValue(var Value: TDateTime): Boolean;
  506.     procedure SetDisplayFormat(const Value: string);
  507.   protected
  508.     function GetAsDateTime: TDateTime; override;
  509.     function GetAsFloat: Double; override;
  510.     function GetAsString: string; override;
  511.     function GetAsVariant: Variant; override;
  512.     function GetDataSize: Word; override;
  513.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  514.     procedure SetAsDateTime(Value: TDateTime); override;
  515.     procedure SetAsFloat(Value: Double); override;
  516.     procedure SetAsString(const Value: string); override;
  517.     procedure SetVarValue(const Value: Variant); override;
  518.   public
  519.     constructor Create(AOwner: TComponent); override;
  520.     property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  521.   published
  522.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  523.     property EditMask;
  524.   end;
  525.  
  526. { TDateField }
  527.  
  528.   TDateField = class(TDateTimeField)
  529.   protected
  530.     function GetDataSize: Word; override;
  531.   public
  532.     constructor Create(AOwner: TComponent); override;
  533.   end;
  534.  
  535. { TTimeField }
  536.  
  537.   TTimeField = class(TDateTimeField)
  538.   protected
  539.     function GetDataSize: Word; override;
  540.   public
  541.     constructor Create(AOwner: TComponent); override;
  542.   end;
  543.  
  544. { TBinaryField }
  545.  
  546.   TBinaryField = class(TField)
  547.   protected
  548.     class procedure CheckTypeSize(Value: Integer); override;
  549.     function GetAsVariant: Variant; override;
  550.     procedure SetVarValue(const Value: Variant); override;
  551.   public
  552.     constructor Create(AOwner: TComponent); override;
  553.   published
  554.     property Size default 16;
  555.   end;
  556.  
  557. { TBytesField }
  558.  
  559.   TBytesField = class(TBinaryField)
  560.   protected
  561.     function GetDataSize: Word; override;
  562.   public
  563.     constructor Create(AOwner: TComponent); override;
  564.   end;
  565.  
  566. { TVarBytesField }
  567.  
  568.   TVarBytesField = class(TBytesField)
  569.   protected
  570.     function GetDataSize: Word; override;
  571.   public
  572.     constructor Create(AOwner: TComponent); override;
  573.   end;
  574.  
  575. { TBCDField }
  576.  
  577.   TBCDField = class(TNumericField)
  578.   private
  579.     FCurrency: Boolean;
  580.     FCheckRange: Boolean;
  581.     FMinValue: Currency;
  582.     FMaxValue: Currency;
  583.     procedure SetCurrency(Value: Boolean);
  584.     procedure SetMaxValue(Value: Currency);
  585.     procedure SetMinValue(Value: Currency);
  586.     procedure UpdateCheckRange;
  587.   protected
  588.     class procedure CheckTypeSize(Value: Integer); override;
  589.     function GetAsCurrency: Currency; override;
  590.     function GetAsFloat: Double; override;
  591.     function GetAsInteger: Longint; override;
  592.     function GetAsString: string; override;
  593.     function GetAsVariant: Variant; override;
  594.     function GetDataSize: Word; override;
  595.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  596.     function GetValue(var Value: Currency): Boolean;
  597.     procedure SetAsCurrency(Value: Currency); override;
  598.     procedure SetAsFloat(Value: Double); override;
  599.     procedure SetAsInteger(Value: Longint); override;
  600.     procedure SetAsString(const Value: string); override;
  601.     procedure SetVarValue(const Value: Variant); override;
  602.   public
  603.     constructor Create(AOwner: TComponent); override;
  604.     property Value: Currency read GetAsCurrency write SetAsCurrency;
  605.   published
  606.     property Currency: Boolean read FCurrency write SetCurrency default False;
  607.     property MaxValue: Currency read FMaxValue write SetMaxValue;
  608.     property MinValue: Currency read FMinValue write SetMinValue;
  609.     property Size default 4;
  610.   end;
  611.  
  612. { TBlobField }
  613.  
  614.   TBlobType = ftBlob..ftTypedBinary;
  615.  
  616.   TBlobField = class(TField)
  617.   private
  618.     FModified: Boolean;
  619.     FModifiedRecord: Integer;
  620.     FTransliterate: Boolean;
  621.     function GetBlobType: TBlobType;
  622.     function GetModified: Boolean;
  623.     procedure LoadFromBlob(Blob: TBlobField);
  624.     procedure LoadFromBitmap(Bitmap: TBitmap);
  625.     procedure LoadFromStrings(Strings: TStrings);
  626.     procedure SaveToBitmap(Bitmap: TBitmap);
  627.     procedure SaveToStrings(Strings: TStrings);
  628.     procedure SetBlobType(Value: TBlobType);
  629.     procedure SetModified(Value: Boolean);
  630.   protected
  631.     procedure AssignTo(Dest: TPersistent); override;
  632.     procedure FreeBuffers; override;
  633.     function GetAsString: string; override;
  634.     function GetAsVariant: Variant; override;
  635.     function GetIsNull: Boolean; override;
  636.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  637.     procedure SetAsString(const Value: string); override;
  638.     procedure SetVarValue(const Value: Variant); override;
  639.   public
  640.     constructor Create(AOwner: TComponent); override;
  641.     procedure Assign(Source: TPersistent); override;
  642.     procedure Clear; override;
  643.     class function IsBlob: Boolean; override;
  644.     procedure LoadFromFile(const FileName: string);
  645.     procedure LoadFromStream(Stream: TStream);
  646.     procedure SaveToFile(const FileName: string);
  647.     procedure SaveToStream(Stream: TStream);
  648.     procedure SetFieldType(Value: TFieldType); override;
  649.     procedure SetText(const Value: string); override;
  650.     property Modified: Boolean read GetModified write SetModified;
  651.     property Value: string read GetAsString write SetAsString;
  652.     property Transliterate: Boolean read FTransliterate write FTransliterate;
  653.   published
  654.     property BlobType: TBlobType read GetBlobType write SetBlobType;
  655.     property Size default 0;
  656.   end;
  657.  
  658. { TMemoField }
  659.  
  660.   TMemoField = class(TBlobField)
  661.   public
  662.     constructor Create(AOwner: TComponent); override;
  663.   published
  664.     property Transliterate default True;
  665.   end;
  666.  
  667. { TGraphicField }
  668.  
  669.   TGraphicField = class(TBlobField)
  670.   public
  671.     constructor Create(AOwner: TComponent); override;
  672.   end;
  673.  
  674. { TIndexDef }
  675.  
  676.   TIndexDefs = class;
  677.  
  678.   TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  679.     ixCaseInsensitive, ixExpression);
  680.  
  681.   TIndexDef = class
  682.   private
  683.     FOwner: TIndexDefs;
  684.     FSource: string;
  685.     FName: string;
  686.     FFields: string;
  687.     FOptions: TIndexOptions;
  688.     function GetExpression: string;
  689.     function GetFields: string;
  690.   public
  691.     constructor Create(Owner: TIndexDefs; const Name, Fields: string;
  692.       Options: TIndexOptions);
  693.     destructor Destroy; override;
  694.     property Expression: string read GetExpression;
  695.     property Fields: string read GetFields;
  696.     property Name: string read FName;
  697.     property Options: TIndexOptions read FOptions;
  698.     property Source: string read FSource write FSource;
  699.   end;
  700.  
  701. { TIndexDefs }
  702.  
  703.   TIndexDefs = class
  704.   private
  705.     FDataSet: TDataSet;
  706.     FItems: TList;
  707.     FUpdated: Boolean;
  708.     function GetCount: Integer;
  709.     function GetItem(Index: Integer): TIndexDef;
  710.   public
  711.     constructor Create(DataSet: TDataSet);
  712.     destructor Destroy; override;
  713.     procedure Add(const Name, Fields: string; Options: TIndexOptions);
  714.     procedure Assign(IndexDefs: TIndexDefs);
  715.     procedure Clear;
  716.     function FindIndexForFields(const Fields: string): TIndexDef;
  717.     function GetIndexForFields(const Fields: string;
  718.       CaseInsensitive: Boolean): TIndexDef;
  719.     function IndexOf(const Name: string): Integer;
  720.     procedure Update;
  721.     property Count: Integer read GetCount;
  722.     property Items[Index: Integer]: TIndexDef read GetItem; default;
  723.     property Updated: Boolean read FUpdated write FUpdated;
  724.   end;
  725.  
  726. { TDataLink }
  727.  
  728.   TDataLink = class(TPersistent)
  729.   private
  730.     FDataSource: TDataSource;
  731.     FNext: TDataLink;
  732.     FBufferCount: Integer;
  733.     FFirstRecord: Integer;
  734.     FReadOnly: Boolean;
  735.     FActive: Boolean;
  736.     FEditing: Boolean;
  737.     FUpdating: Boolean;
  738.     FDataSourceFixed: Boolean;
  739.     procedure DataEvent(Event: TDataEvent; Info: Longint);
  740.     function GetActiveRecord: Integer;
  741.     function GetDataSet: TDataSet;
  742.     function GetRecordCount: Integer;
  743.     procedure SetActive(Value: Boolean);
  744.     procedure SetActiveRecord(Value: Integer);
  745.     procedure SetBufferCount(Value: Integer);
  746.     procedure SetDataSource(ADataSource: TDataSource);
  747.     procedure SetEditing(Value: Boolean);
  748.     procedure SetReadOnly(Value: Boolean);
  749.     procedure UpdateRange;
  750.     procedure UpdateState;
  751.   protected
  752.     procedure ActiveChanged; virtual;
  753.     procedure CheckBrowseMode; virtual;
  754.     procedure DataSetChanged; virtual;
  755.     procedure DataSetScrolled(Distance: Integer); virtual;
  756.     procedure FocusControl(Field: TFieldRef); virtual;
  757.     procedure EditingChanged; virtual;
  758.     procedure LayoutChanged; virtual;
  759.     procedure RecordChanged(Field: TField); virtual;
  760.     procedure UpdateData; virtual;
  761.   public
  762.     constructor Create;
  763.     destructor Destroy; override;
  764.     function Edit: Boolean;
  765.     procedure UpdateRecord;
  766.     property Active: Boolean read FActive;
  767.     property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  768.     property BufferCount: Integer read FBufferCount write SetBufferCount;
  769.     property DataSet: TDataSet read GetDataSet;
  770.     property DataSource: TDataSource read FDataSource write SetDataSource;
  771.     property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  772.     property Editing: Boolean read FEditing;
  773.     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  774.     property RecordCount: Integer read GetRecordCount;
  775.   end;
  776.  
  777. { TDataSource }
  778.  
  779.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  780.  
  781.   TDataSource = class(TComponent)
  782.   private
  783.     FDataSet: TDataSet;
  784.     FDataLinks: TList;
  785.     FEnabled: Boolean;
  786.     FAutoEdit: Boolean;
  787.     FState: TDataSetState;
  788.     FOnStateChange: TNotifyEvent;
  789.     FOnDataChange: TDataChangeEvent;
  790.     FOnUpdateData: TNotifyEvent;
  791.     procedure AddDataLink(DataLink: TDataLink);
  792.     procedure DataEvent(Event: TDataEvent; Info: Longint);
  793.     procedure NotifyDataLinks(Event: TDataEvent; Info: Longint);
  794.     procedure RemoveDataLink(DataLink: TDataLink);
  795.     procedure SetDataSet(ADataSet: TDataSet);
  796.     procedure SetEnabled(Value: Boolean);
  797.     procedure SetState(Value: TDataSetState);
  798.     procedure UpdateState;
  799.   public
  800.     constructor Create(AOwner: TComponent); override;
  801.     destructor Destroy; override;
  802.     procedure Edit;
  803.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  804.     property State: TDataSetState read FState;
  805.   published
  806.     property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  807.     property DataSet: TDataSet read FDataSet write SetDataSet;
  808.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  809.     property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  810.     property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  811.     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  812.   end;
  813.  
  814. { TDataSetDesigner }
  815.  
  816.   TDataSetDesigner = class(TObject)
  817.   private
  818.     FDataSet: TDataSet;
  819.     FSaveActive: Boolean;
  820.   public
  821.     constructor Create(DataSet: TDataSet);
  822.     destructor Destroy; override;
  823.     procedure BeginDesign;
  824.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  825.     procedure EndDesign;
  826.     property DataSet: TDataSet read FDataSet;
  827.   end;
  828.  
  829. { TCheckConstraint }
  830.  
  831.   TCheckConstraint = class(TCollectionItem)
  832.   private
  833.     FImportedConstraint: string;
  834.     FCustomConstraint: string;
  835.     FErrorMessage: string;
  836.     FFromDictionary: Boolean;
  837.     procedure SetImportedConstraint(const Value: string);
  838.     procedure SetCustomConstraint(const Value: string);
  839.     procedure SetErrorMessage(const Value: string);
  840.   public
  841.     procedure Assign(Source: TPersistent); override;
  842.     function GetDisplayName: string; override;
  843.   published
  844.     property CustomConstraint: string read FCustomConstraint write SetCustomConstraint;
  845.     property ErrorMessage: string read FErrorMessage write SetErrorMessage;
  846.     property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  847.     property ImportedConstraint: string read FImportedConstraint write SetImportedConstraint;
  848.   end;
  849.  
  850. { TCheckConstraints }
  851.  
  852.   TCheckConstraints = class(TCollection)
  853.   private
  854.     FOwner: TPersistent;
  855.     function GetItem(Index: Integer): TCheckConstraint;
  856.     procedure SetItem(Index: Integer; Value: TCheckConstraint);
  857.   protected
  858.     function GetOwner: TPersistent; override;
  859.   public
  860.     constructor Create(Owner: TPersistent);
  861.     function Add: TCheckConstraint;
  862.     property Items[Index: Integer]: TCheckConstraint read GetItem write SetItem; default;
  863.   end;
  864.  
  865. { TDataSet }
  866.  
  867.   TBookmark = Pointer;
  868.   TBookmarkStr = string;
  869.  
  870.   PBookmarkFlag = ^TBookmarkFlag;
  871.   TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  872.  
  873.   PBufferList = ^TBufferList;
  874.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  875.  
  876.   TGetMode = (gmCurrent, gmNext, gmPrior);
  877.  
  878.   TGetResult = (grOK, grBOF, grEOF, grError);
  879.  
  880.   TResyncMode = set of (rmExact, rmCenter);
  881.  
  882.   TDataAction = (daFail, daAbort, daRetry);
  883.  
  884.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  885.  
  886.   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  887.  
  888.   TLocateOption = (loCaseInsensitive, loPartialKey);
  889.   TLocateOptions = set of TLocateOption;
  890.  
  891.   TDataOperation = procedure of object;
  892.  
  893.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  894.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  895.     var Action: TDataAction) of object;
  896.  
  897.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  898.   TFilterOptions = set of TFilterOption;
  899.  
  900.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  901.     var Accept: Boolean) of object;
  902.  
  903.   TDataSet = class(TComponent)
  904.   private
  905.     FFields: TList;
  906.     FFieldDefs: TFieldDefs;
  907.     FDataSources: TList;
  908.     FFirstDataLink: TDataLink;
  909.     FBufferCount: Integer;
  910.     FRecordCount: Integer;
  911.     FActiveRecord: Integer;
  912.     FCurrentRecord: Integer;
  913.     FBuffers: PBufferList;
  914.     FCalcBuffer: PChar;
  915.     FBufListSize: Integer;
  916.     FBookmarkSize: Integer;
  917.     FCalcFieldsSize: Integer;
  918.     FBOF: Boolean;
  919.     FEOF: Boolean;
  920.     FModified: Boolean;
  921.     FStreamedActive: Boolean;
  922.     FInternalCalcFields: Boolean;
  923.     FState: TDataSetState;
  924.     FEnableEvent: TDataEvent;
  925.     FDisableState: TDataSetState;
  926.     FDesigner: TDataSetDesigner;
  927.     FDisableCount: Integer;
  928.     FFound: Boolean;
  929.     FDefaultFields: Boolean;
  930.     FAutoCalcFields: Boolean;
  931.     FFiltered: Boolean;
  932.     FBlobFieldCount: Integer;
  933.     FFilterText: string;
  934.     FFilterOptions: TFilterOptions;
  935.     FConstraints: TCheckConstraints;
  936.     FBeforeOpen: TDataSetNotifyEvent;
  937.     FAfterOpen: TDataSetNotifyEvent;
  938.     FBeforeClose: TDataSetNotifyEvent;
  939.     FAfterClose: TDataSetNotifyEvent;
  940.     FBeforeInsert: TDataSetNotifyEvent;
  941.     FAfterInsert: TDataSetNotifyEvent;
  942.     FBeforeEdit: TDataSetNotifyEvent;
  943.     FAfterEdit: TDataSetNotifyEvent;
  944.     FBeforePost: TDataSetNotifyEvent;
  945.     FAfterPost: TDataSetNotifyEvent;
  946.     FBeforeCancel: TDataSetNotifyEvent;
  947.     FAfterCancel: TDataSetNotifyEvent;
  948.     FBeforeDelete: TDataSetNotifyEvent;
  949.     FAfterDelete: TDataSetNotifyEvent;
  950.     FBeforeScroll: TDataSetNotifyEvent;
  951.     FAfterScroll: TDataSetNotifyEvent;
  952.     FOnNewRecord: TDataSetNotifyEvent;
  953.     FOnCalcFields: TDataSetNotifyEvent;
  954.     FOnEditError: TDataSetErrorEvent;
  955.     FOnPostError: TDataSetErrorEvent;
  956.     FOnDeleteError: TDataSetErrorEvent;
  957.     FOnFilterRecord: TFilterRecordEvent;
  958.     procedure AddDataSource(DataSource: TDataSource);
  959.     procedure AddField(Field: TField);
  960.     procedure AddRecord(const Values: array of const; Append: Boolean);
  961.     procedure BeginInsertAppend;
  962.     procedure CheckCanModify;
  963.     procedure CheckFieldName(const FieldName: string);
  964.     procedure CheckFieldNames(const FieldNames: string);
  965.     procedure CheckOperation(Operation: TDataOperation;
  966.       ErrorEvent: TDataSetErrorEvent);
  967.     procedure CheckRequiredFields;
  968.     procedure DoInternalOpen;
  969.     procedure DoInternalClose;
  970.     procedure EndInsertAppend;
  971.     function GetActive: Boolean;
  972.     function GetBuffer(Index: Integer): PChar;
  973.     function GetField(Index: Integer): TField;
  974.     function GetFieldCount: Integer;
  975.     function GetFieldValue(const FieldName: string): Variant;
  976.     function GetFound: Boolean;
  977.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  978.     procedure RemoveDataSource(DataSource: TDataSource);
  979.     procedure RemoveField(Field: TField);
  980.     procedure SetActive(Value: Boolean);
  981.     procedure SetBufferCount(Value: Integer);
  982.     procedure SetField(Index: Integer; Value: TField);
  983.     procedure SetFieldDefs(Value: TFieldDefs);
  984.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  985.     procedure SetConstraints(const Value: TCheckConstraints);
  986.     procedure UpdateBufferCount;
  987.     procedure UpdateFieldDefs;
  988.   protected
  989.     procedure ActivateBuffers; virtual;
  990.     procedure BindFields(Binding: Boolean);
  991.     function BookmarkAvailable: Boolean;
  992.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; virtual;
  993.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  994.       Decimals: Integer): Boolean; virtual;
  995.     procedure CalculateFields(Buffer: PChar); virtual;
  996.     procedure CheckActive; virtual;
  997.     procedure CheckInactive; virtual;
  998.     procedure ClearBuffers; virtual;
  999.     procedure ClearCalcFields(Buffer: PChar); virtual;
  1000.     procedure CloseBlob(Field: TField); virtual;
  1001.     procedure CloseCursor; virtual;
  1002.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  1003.     procedure CreateFields;
  1004.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  1005.     procedure DestroyFields; virtual;
  1006.     procedure DoAfterCancel; virtual;
  1007.     procedure DoAfterClose; virtual;
  1008.     procedure DoAfterDelete; virtual;
  1009.     procedure DoAfterEdit; virtual;
  1010.     procedure DoAfterInsert; virtual;
  1011.     procedure DoAfterOpen; virtual;
  1012.     procedure DoAfterPost; virtual;
  1013.     procedure DoAfterScroll; virtual;
  1014.     procedure DoBeforeCancel; virtual;
  1015.     procedure DoBeforeClose; virtual;
  1016.     procedure DoBeforeDelete; virtual;
  1017.     procedure DoBeforeEdit; virtual;
  1018.     procedure DoBeforeInsert; virtual;
  1019.     procedure DoBeforeOpen; virtual;
  1020.     procedure DoBeforePost; virtual;
  1021.     procedure DoBeforeScroll; virtual;
  1022.     procedure DoOnCalcFields; virtual;
  1023.     procedure DoOnNewRecord; virtual;
  1024.     function FieldByNumber(FieldNo: Integer): TField;
  1025.     function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  1026.     procedure FreeFieldBuffers; virtual;
  1027.     function GetBookmarkStr: TBookmarkStr; virtual;
  1028.     procedure GetCalcFields(Buffer: PChar); virtual;
  1029.     function GetCanModify: Boolean; virtual;
  1030.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1031.     function GetDataSource: TDataSource; virtual;
  1032.     function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  1033.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; virtual;
  1034.     function GetIsIndexField(Field: TField): Boolean; virtual;
  1035.     function GetNextRecords: Integer; virtual;
  1036.     function GetNextRecord: Boolean; virtual;
  1037.     function GetPriorRecords: Integer; virtual;
  1038.     function GetPriorRecord: Boolean; virtual;
  1039.     function GetRecordCount: Integer; virtual;
  1040.     function GetRecNo: Integer; virtual;
  1041.     procedure InitFieldDefs; virtual;
  1042.     procedure InitRecord(Buffer: PChar); virtual;
  1043.     procedure InternalCancel; virtual;
  1044.     procedure InternalEdit; virtual;
  1045.     procedure InternalRefresh; virtual;
  1046.     procedure Loaded; override;
  1047.     procedure OpenCursor(InfoQuery: Boolean); virtual;
  1048.     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  1049.     procedure RestoreState(const Value: TDataSetState);
  1050.     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  1051.     procedure SetBufListSize(Value: Integer);
  1052.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  1053.     procedure SetCurrentRecord(Index: Integer); virtual;
  1054.     procedure SetFiltered(Value: Boolean); virtual;
  1055.     procedure SetFilterOptions(Value: TFilterOptions); virtual;
  1056.     procedure SetFilterText(const Value: string); virtual;
  1057.     procedure SetFound(const Value: Boolean);
  1058.     procedure SetModified(Value: Boolean);
  1059.     procedure SetName(const Value: TComponentName); override;
  1060.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); virtual;
  1061.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  1062.     procedure SetRecNo(Value: Integer); virtual;
  1063.     procedure SetState(Value: TDataSetState);
  1064.     function SetTempState(const Value: TDataSetState): TDataSetState;
  1065.     function TempBuffer: PChar;
  1066.     procedure UpdateIndexDefs; virtual;
  1067.     property ActiveRecord: Integer read FActiveRecord;
  1068.     property CurrentRecord: Integer read FCurrentRecord;
  1069.     property BlobFieldCount: Integer read FBlobFieldCount;
  1070.     property BookmarkSize: Integer read FBookmarkSize write FBookmarkSize;
  1071.     property Buffers[Index: Integer]: PChar read GetBuffer;
  1072.     property BufferCount: Integer read FBufferCount;
  1073.     property CalcBuffer: PChar read FCalcBuffer;
  1074.     property CalcFieldsSize: Integer read FCalcFieldsSize;
  1075.     property InternalCalcFields: Boolean read FInternalCalcFields;
  1076.     property Constraints: TCheckConstraints read FConstraints write SetConstraints;
  1077.   protected { abstract methods }
  1078.     function AllocRecordBuffer: PChar; virtual; abstract;
  1079.     procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  1080.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1081.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  1082.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  1083.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  1084.     function GetRecordSize: Word; virtual; abstract;
  1085.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  1086.     procedure InternalClose; virtual; abstract;
  1087.     procedure InternalDelete; virtual; abstract;
  1088.     procedure InternalFirst; virtual; abstract;
  1089.     procedure InternalGotoBookmark(Bookmark: Pointer); virtual; abstract;
  1090.     procedure InternalHandleException; virtual; abstract;
  1091.     procedure InternalInitFieldDefs; virtual; abstract;
  1092.     procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  1093.     procedure InternalLast; virtual; abstract;
  1094.     procedure InternalOpen; virtual; abstract;
  1095.     procedure InternalPost; virtual; abstract;
  1096.     procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  1097.     function IsCursorOpen: Boolean; virtual; abstract;
  1098.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  1099.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1100.     procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  1101.   public
  1102.     constructor Create(AOwner: TComponent); override;
  1103.     destructor Destroy; override;
  1104.     function ActiveBuffer: PChar;
  1105.     procedure Append;
  1106.     procedure AppendRecord(const Values: array of const);
  1107.     function BookmarkValid(Bookmark: TBookmark): Boolean; virtual;
  1108.     procedure Cancel; virtual;
  1109.     procedure CheckBrowseMode;
  1110.     procedure ClearFields;
  1111.     procedure Close;
  1112.     function  ControlsDisabled: Boolean;
  1113.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; virtual;
  1114.     procedure CursorPosChanged;
  1115.     procedure Delete;
  1116.     procedure DisableControls;
  1117.     procedure Edit;
  1118.     procedure EnableControls;
  1119.     function FieldByName(const FieldName: string): TField;
  1120.     function FindField(const FieldName: string): TField;
  1121.     function FindFirst: Boolean;
  1122.     function FindLast: Boolean;
  1123.     function FindNext: Boolean;
  1124.     function FindPrior: Boolean;
  1125.     procedure First;
  1126.     procedure FreeBookmark(Bookmark: TBookmark); virtual;
  1127.     function GetBookmark: TBookmark; virtual;
  1128.     function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  1129.     procedure GetFieldList(List: TList; const FieldNames: string);
  1130.     procedure GetFieldNames(List: TStrings);
  1131.     procedure GotoBookmark(Bookmark: TBookmark);
  1132.     procedure Insert;
  1133.     procedure InsertRecord(const Values: array of const);
  1134.     function IsEmpty: Boolean;
  1135.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  1136.     procedure Last;
  1137.     function Locate(const KeyFields: string; const KeyValues: Variant;
  1138.       Options: TLocateOptions): Boolean; virtual;
  1139.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  1140.       const ResultFields: string): Variant; virtual;
  1141.     function MoveBy(Distance: Integer): Integer;
  1142.     procedure Next;
  1143.     procedure Open;
  1144.     procedure Post; virtual;
  1145.     procedure Prior;
  1146.     procedure Refresh;
  1147.     procedure Resync(Mode: TResyncMode); virtual;
  1148.     procedure SetFields(const Values: array of const);
  1149.     procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
  1150.     procedure UpdateCursorPos;
  1151.     procedure UpdateRecord;
  1152.     property BOF: Boolean read FBOF;
  1153.     property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
  1154.     property CanModify: Boolean read GetCanModify;
  1155.     property DataSource: TDataSource read GetDataSource;
  1156.     property DefaultFields: Boolean read FDefaultFields;
  1157.     property Designer: TDataSetDesigner read FDesigner;
  1158.     property EOF: Boolean read FEOF;
  1159.     property FieldCount: Integer read GetFieldCount;
  1160.     property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;
  1161.     property Fields[Index: Integer]: TField read GetField write SetField;
  1162.     property FieldValues[const FieldName: string]: Variant read GetFieldValue write SetFieldValue; default;
  1163.     property Found: Boolean read GetFound;
  1164.     property Modified: Boolean read FModified;
  1165.     property RecordCount: Integer read GetRecordCount;
  1166.     property RecNo: Integer read GetRecNo write SetRecNo;
  1167.     property RecordSize: Word read GetRecordSize;
  1168.     property State: TDataSetState read FState;
  1169.     property Filter: string read FFilterText write SetFilterText;
  1170.     property Filtered: Boolean read FFiltered write SetFiltered default False;
  1171.     property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions default [];
  1172.     property Active: Boolean read GetActive write SetActive default False;
  1173.     property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields default True;
  1174.     property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  1175.     property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  1176.     property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  1177.     property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  1178.     property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  1179.     property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  1180.     property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  1181.     property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  1182.     property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  1183.     property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  1184.     property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  1185.     property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  1186.     property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  1187.     property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  1188.     property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  1189.     property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  1190.     property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  1191.     property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  1192.     property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  1193.     property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  1194.     property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  1195.     property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  1196.   end;
  1197.  
  1198. { TDateTimeRec }
  1199.   
  1200. type
  1201.   TDateTimeRec = record
  1202.     case TFieldType of
  1203.       ftDate: (Date: Longint);
  1204.       ftTime: (Time: Longint);
  1205.       ftDateTime: (DateTime: TDateTime);
  1206.   end;
  1207.  
  1208. const
  1209.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  1210.   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsNewValue];
  1211.  
  1212.   DefaultFieldClasses: array[ftUnknown..ftTypedBinary] of TFieldClass = (
  1213.     nil,                { ftUnknown }
  1214.     TStringField,       { ftString }
  1215.     TSmallintField,     { ftSmallint }
  1216.     TIntegerField,      { ftInteger }
  1217.     TWordField,         { ftWord }
  1218.     TBooleanField,      { ftBoolean }
  1219.     TFloatField,        { ftFloat }
  1220.     TCurrencyField,     { ftCurrency }
  1221.     TBCDField,          { ftBCD }
  1222.     TDateField,         { ftDate }
  1223.     TTimeField,         { ftTime }
  1224.     TDateTimeField,     { ftDateTime }
  1225.     TBytesField,        { ftBytes }
  1226.     TVarBytesField,     { ftVarBytes }
  1227.     TAutoIncField,      { ftAutoInc }
  1228.     TBlobField,         { ftBlob }
  1229.     TMemoField,         { ftMemo }
  1230.     TGraphicField,      { ftGraphic }
  1231.     TBlobField,         { ftFmtMemo }
  1232.     TBlobField,         { ftParadoxOle }
  1233.     TBlobField,         { ftDBaseOle }
  1234.     TBlobField);        { ftTypedBinary }
  1235.  
  1236. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  1237. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  1238.  
  1239. procedure DatabaseError(const Message: string);
  1240. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  1241. procedure DBError(Ident: Word);
  1242. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  1243.  
  1244. procedure DisposeMem(var Buffer; Size: Integer);
  1245. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  1246.  
  1247. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  1248.   const FieldName: string): TField;
  1249.  
  1250. const
  1251.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  1252.  
  1253. implementation
  1254.  
  1255. uses DBConsts, Mask;
  1256.  
  1257. { Paradox graphic BLOB header }
  1258.  
  1259. type
  1260.   TGraphicHeader = record
  1261.     Count: Word;                { Fixed at 1 }
  1262.     HType: Word;                { Fixed at $0100 }
  1263.     Size: Longint;              { Size not including header }
  1264.   end;
  1265.  
  1266. { Error and exception handling routines }
  1267.  
  1268. procedure DatabaseError(const Message: string);
  1269. begin
  1270.   raise EDatabaseError.Create(Message);
  1271. end;
  1272.  
  1273. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  1274. begin
  1275.   raise EDatabaseError.CreateFmt(Message, Args);
  1276. end;
  1277.  
  1278. procedure DBError(Ident: Word);
  1279. begin
  1280.   DatabaseError(LoadStr(Ident));
  1281. end;
  1282.  
  1283. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  1284. begin
  1285.   DatabaseError(FmtLoadStr(Ident, Args));
  1286. end;
  1287.  
  1288. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  1289.   const FieldName: string): TField;
  1290. begin
  1291.   Result := DataSet.FindField(FieldName);
  1292.   if Result = nil then
  1293.     DatabaseErrorFmt(SFieldNotFound, [Control.Name, FieldName]);
  1294. end;
  1295.  
  1296. { Utility routines }
  1297.  
  1298. procedure DisposeMem(var Buffer; Size: Integer);
  1299. begin
  1300.   if Pointer(Buffer) <> nil then
  1301.   begin
  1302.     FreeMem(Pointer(Buffer), Size);
  1303.     Pointer(Buffer) := nil;
  1304.   end;
  1305. end;
  1306.  
  1307. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean; assembler;
  1308. asm
  1309.         PUSH    EDI
  1310.         PUSH    ESI
  1311.         MOV     ESI,Buf1
  1312.         MOV     EDI,Buf2
  1313.         XOR     EAX,EAX
  1314.         JECXZ   @@1
  1315.         CLD
  1316.         REPE    CMPSB
  1317.         JNE     @@1
  1318.         INC     EAX
  1319. @@1:    POP     ESI
  1320.         POP     EDI
  1321. end;
  1322.  
  1323. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  1324. var
  1325.   I: Integer;
  1326. begin
  1327.   I := Pos;
  1328.   while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  1329.   Result := Trim(Copy(Fields, Pos, I - Pos));
  1330.   if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  1331.   Pos := I;
  1332. end;
  1333.  
  1334. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  1335. begin
  1336.   if Assigned(RegisterFieldsProc) then
  1337.     RegisterFieldsProc(FieldClasses) else
  1338.     DatabaseError(SInvalidFieldRegistration);
  1339. end;
  1340.  
  1341. { TDataSetDesigner }
  1342.  
  1343. constructor TDataSetDesigner.Create(DataSet: TDataSet);
  1344. begin
  1345.   FDataSet := DataSet;
  1346.   FDataSet.FDesigner := Self;
  1347. end;
  1348.  
  1349. destructor TDataSetDesigner.Destroy;
  1350. begin
  1351.   FDataSet.FDesigner := nil;
  1352. end;
  1353.  
  1354. procedure TDataSetDesigner.BeginDesign;
  1355. begin
  1356.   FSaveActive := FDataSet.Active;
  1357.   if FSaveActive then
  1358.   begin
  1359.     FDataSet.DoInternalClose;
  1360.     FDataSet.SetState(dsInactive);
  1361.   end;
  1362.   FDataSet.DisableControls;
  1363. end;
  1364.  
  1365. procedure TDataSetDesigner.DataEvent(Event: TDataEvent; Info: Longint);
  1366. begin
  1367. end;
  1368.  
  1369. procedure TDataSetDesigner.EndDesign;
  1370. begin
  1371.   FDataSet.EnableControls;
  1372.   if FSaveActive then
  1373.   begin
  1374.     try
  1375.       FDataSet.DoInternalOpen;
  1376.       FDataSet.SetState(dsBrowse);
  1377.     except
  1378.       FDataSet.SetState(dsInactive);
  1379.       FDataSet.CloseCursor;
  1380.       raise;
  1381.     end;
  1382.   end;
  1383. end;
  1384.  
  1385. { TFieldDef }
  1386.  
  1387. constructor TFieldDef.Create(Owner: TFieldDefs; const Name: string;
  1388.   DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  1389. var
  1390.   FieldClass: TFieldClass;
  1391. begin
  1392.   FieldClass := Owner.FDataSet.GetFieldClass(DataType);
  1393.   if Assigned(FieldClass) then
  1394.     FieldClass.CheckTypeSize(Size);
  1395.   if Owner <> nil then
  1396.   begin
  1397.     Owner.FItems.Add(Self);
  1398.     Owner.FUpdated := False;
  1399.     FOwner := Owner;
  1400.   end;
  1401.   FName := Name;
  1402.   FDataType := DataType;
  1403.   FSize := Size;
  1404.   FRequired := Required;
  1405.   FFieldNo := FieldNo;
  1406. end;
  1407.  
  1408. destructor TFieldDef.Destroy;
  1409. begin
  1410.   if FOwner <> nil then
  1411.   begin
  1412.     FOwner.FItems.Remove(Self);
  1413.     FOwner.FUpdated := False;
  1414.   end;
  1415. end;
  1416.  
  1417. function TFieldDef.CreateField(Owner: TComponent): TField;
  1418. var
  1419.   FieldClass: TFieldClass;
  1420. begin
  1421.   FieldClass := GetFieldClass;
  1422.   if FieldClass = nil then DatabaseErrorFmt(SUnknownFieldType, [Name]);
  1423.   Result := FieldClass.Create(Owner);
  1424.   try
  1425.     Result.FieldName := Name;
  1426.     Result.Size := FSize;
  1427.     Result.Required := FRequired;
  1428.     Result.SetFieldType(FDataType);
  1429.     if FOwner <> nil then Result.DataSet := FOwner.FDataSet;
  1430.   except
  1431.     Result.Free;
  1432.     raise;
  1433.   end;
  1434. end;
  1435.  
  1436. function TFieldDef.GetFieldClass: TFieldClass;
  1437. begin
  1438.   Result := FOwner.FDataSet.GetFieldClass(FDataType);
  1439. end;
  1440.  
  1441. { TFieldDefs }
  1442.  
  1443. constructor TFieldDefs.Create(DataSet: TDataSet);
  1444. begin
  1445.   FDataSet := DataSet;
  1446.   FItems := TList.Create;
  1447. end;
  1448.  
  1449. destructor TFieldDefs.Destroy;
  1450. begin
  1451.   if FItems <> nil then Clear;
  1452.   FItems.Free;
  1453. end;
  1454.  
  1455. procedure TFieldDefs.Add(const Name: string; DataType: TFieldType;
  1456.   Size: Word; Required: Boolean);
  1457. begin
  1458.   if Name = '' then DatabaseError(SFieldNameMissing);
  1459.   if IndexOf(Name) >= 0 then DatabaseErrorFmt(SDuplicateFieldName, [Name]);
  1460.   TFieldDef.Create(Self, Name, DataType, Size, Required, FItems.Count + 1);
  1461. end;
  1462.  
  1463. procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
  1464. var
  1465.   I: Integer;
  1466. begin
  1467.   Clear;
  1468.   for I := 0 to FieldDefs.Count - 1 do
  1469.     with FieldDefs[I] do Add(Name, DataType, Size, Required);
  1470. end;
  1471.  
  1472. procedure TFieldDefs.Clear;
  1473. begin
  1474.   while FItems.Count > 0 do TFieldDef(FItems.Last).Free;
  1475. end;
  1476.  
  1477. function TFieldDefs.Find(const Name: string): TFieldDef;
  1478. var
  1479.   I: Integer;
  1480. begin
  1481.   I := IndexOf(Name);
  1482.   if I < 0 then DatabaseErrorFmt(SFieldNotFound, [FDataset.Name, Name]);
  1483.   Result := FItems[I];
  1484. end;
  1485.  
  1486. function TFieldDefs.GetCount: Integer;
  1487. begin
  1488.   Result := FItems.Count;
  1489. end;
  1490.  
  1491. function TFieldDefs.GetItem(Index: Integer): TFieldDef;
  1492. begin
  1493.   Result := FItems[Index];
  1494. end;
  1495.  
  1496. function TFieldDefs.IndexOf(const Name: string): Integer;
  1497. begin
  1498.   for Result := 0 to FItems.Count - 1 do
  1499.     if AnsiCompareText(TFieldDef(FItems[Result]).Name, Name) = 0 then Exit;
  1500.   Result := -1;
  1501. end;
  1502.  
  1503. procedure TFieldDefs.Update;
  1504. begin
  1505.   FDataSet.UpdateFieldDefs;
  1506. end;
  1507.  
  1508. { TLookupList }
  1509.  
  1510. constructor TLookupList.Create;
  1511. begin
  1512.   FList := TList.Create;
  1513. end;
  1514.  
  1515. destructor TLookupList.Destroy;
  1516. begin
  1517.   if Assigned(FList) then Clear;
  1518.   FList.Free;
  1519. end;
  1520.  
  1521. procedure TLookupList.Add(const AKey, AValue: Variant);
  1522. var
  1523.   ListEntry: PLookupListEntry;
  1524. begin
  1525.   New(ListEntry);
  1526.   ListEntry.Key := AKey;
  1527.   ListEntry.Value := AValue;
  1528.   FList.Add(ListEntry);
  1529. end;
  1530.  
  1531. procedure TLookupList.Clear;
  1532. var
  1533.   I: Integer;
  1534. begin
  1535.   for I := 0 to FList.Count - 1 do
  1536.     Dispose(PLookupListEntry(FList.Items[I]));
  1537.   FList.Clear;
  1538. end;
  1539.  
  1540. function TLookupList.ValueOfKey(const AKey: Variant): Variant;
  1541. var
  1542.   I: Integer;
  1543. begin
  1544.   Result := Null;
  1545.   if not VarIsNull(AKey) then
  1546.     for I := 0 to FList.Count - 1 do
  1547.       if PLookupListEntry(FList.Items[I]).Key = AKey then
  1548.       begin
  1549.         Result := PLookupListEntry(FList.Items[I]).Value;
  1550.         Break;
  1551.       end;
  1552. end;
  1553.  
  1554. { TField }
  1555.  
  1556. constructor TField.Create(AOwner: TComponent);
  1557. begin
  1558.   inherited Create(AOwner);
  1559.   FVisible := True;
  1560.   FValidChars := [#0..#255];
  1561. end;
  1562.  
  1563. destructor TField.Destroy;
  1564. begin
  1565.   if FDataSet <> nil then
  1566.   begin
  1567.     FDataSet.Close;
  1568.     FDataSet.RemoveField(Self);
  1569.   end;
  1570.   FLookupList.Free;
  1571.   inherited Destroy;
  1572. end;
  1573.  
  1574. function TField.AccessError(const TypeName: string): EDatabaseError;
  1575. begin
  1576.   Result := EDatabaseError.Create(Format(SFieldAccessError,
  1577.     [DisplayName, TypeName]));
  1578. end;
  1579.  
  1580. procedure TField.Assign(Source: TPersistent);
  1581. begin
  1582.   if Source = nil then
  1583.   begin
  1584.     Clear;
  1585.     Exit;
  1586.   end;
  1587.   if Source is TField then
  1588.   begin
  1589.     Value := TField(Source).Value;
  1590.     Exit;
  1591.   end;
  1592.   inherited Assign(Source);
  1593. end;
  1594.  
  1595. procedure TField.AssignValue(const Value: TVarRec);
  1596.  
  1597.   procedure Error;
  1598.   begin
  1599.     DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  1600.   end;
  1601.  
  1602. begin
  1603.   with Value do
  1604.     case VType of
  1605.       vtInteger:
  1606.         AsInteger := VInteger;
  1607.       vtBoolean:
  1608.         AsBoolean := VBoolean;
  1609.       vtChar:
  1610.         AsString := VChar;
  1611.       vtExtended:
  1612.         AsFloat := VExtended^;
  1613.       vtString:
  1614.         AsString := VString^;
  1615.       vtPointer:
  1616.         if VPointer <> nil then Error;
  1617.       vtPChar:
  1618.         AsString := VPChar;
  1619.       vtObject:
  1620.         if (VObject = nil) or (VObject is TPersistent) then
  1621.           Assign(TPersistent(VObject))
  1622.         else
  1623.           Error;
  1624.       vtAnsiString:
  1625.         AsString := string(VAnsiString);
  1626.       vtCurrency:
  1627.         AsCurrency := VCurrency^;
  1628.       vtVariant:
  1629.         if not VarIsEmpty(VVariant^) then AsVariant := VVariant^;
  1630.     else
  1631.       Error;
  1632.     end;
  1633. end;
  1634.  
  1635. procedure TField.Bind(Binding: Boolean);
  1636. begin
  1637.   if FFieldKind = fkLookup then
  1638.     if Binding then
  1639.     begin
  1640.       if FLookupCache then
  1641.         RefreshLookupList
  1642.       else
  1643.         ValidateLookupInfo(True);
  1644.    end;
  1645. end;
  1646.  
  1647. procedure TField.CalcLookupValue;
  1648. begin
  1649.   if FLookupCache then
  1650.     Value := LookupList.ValueOfKey(FDataSet.FieldValues[FKeyFields])
  1651.   else if (FLookupDataSet <> nil) and FLookupDataSet.Active then
  1652.     Value := FLookupDataSet.Lookup(FLookupKeyFields,
  1653.       FDataSet.FieldValues[FKeyFields], FLookupResultField);
  1654. end;
  1655.  
  1656. procedure TField.Change;
  1657. begin
  1658.   if Assigned(FOnChange) then FOnChange(Self);
  1659. end;
  1660.  
  1661. procedure TField.CheckInactive;
  1662. begin
  1663.   if FDataSet <> nil then FDataSet.CheckInactive;
  1664. end;
  1665.  
  1666. procedure TField.Clear;
  1667. begin
  1668.   SetData(nil);
  1669. end;
  1670.  
  1671. procedure TField.DataChanged;
  1672. begin
  1673.   FDataSet.DataEvent(deFieldChange, Longint(Self));
  1674. end;
  1675.  
  1676. procedure TField.DefineProperties(Filer: TFiler);
  1677.  
  1678.   function DoWrite: Boolean;
  1679.   begin
  1680.     if Assigned(Filer.Ancestor) then
  1681.       Result := CompareText(FAttributeSet, TField(Filer.Ancestor).FAttributeSet) <> 0
  1682.     else
  1683.       Result := FAttributeSet <> '';
  1684.   end;
  1685.  
  1686. begin
  1687.   Filer.DefineProperty('AttributeSet', ReadAttributeSet, WriteAttributeSet,
  1688.     DoWrite);
  1689.   { For backwards compatibility }
  1690.   Filer.DefineProperty('Calculated', ReadCalculated, nil, False);
  1691.   Filer.DefineProperty('Lookup', ReadLookup, nil, False);
  1692. end;
  1693.  
  1694.  
  1695. procedure TField.FocusControl;
  1696. var
  1697.   Field: TField;
  1698. begin
  1699.   if (FDataSet <> nil) and FDataSet.Active then
  1700.   begin
  1701.     Field := Self;
  1702.     FDataSet.DataEvent(deFocusControl, Longint(@Field));
  1703.   end;
  1704. end;
  1705.  
  1706. procedure TField.FreeBuffers;
  1707. begin
  1708. end;
  1709.  
  1710. function TField.GetAsBoolean: Boolean;
  1711. begin
  1712.   raise AccessError('Boolean'); { Do not localize }
  1713. end;
  1714.  
  1715. function TField.GetAsCurrency: Currency;
  1716. begin
  1717.   Result := GetAsFloat;
  1718. end;
  1719.  
  1720. function TField.GetAsDateTime: TDateTime;
  1721. begin
  1722.   raise AccessError('DateTime'); { Do not localize }
  1723. end;
  1724.  
  1725. function TField.GetAsFloat: Double;
  1726. begin
  1727.   raise AccessError('Float'); { Do not localize }
  1728. end;
  1729.  
  1730. function TField.GetAsInteger: Longint;
  1731. begin
  1732.   raise AccessError('Integer'); { Do not localize }
  1733. end;
  1734.  
  1735. function TField.GetAsString: string;
  1736. var
  1737.   I, L: Integer;
  1738.   S: string[63];
  1739. begin
  1740.   S := ClassName;
  1741.   I := 1;
  1742.   L := Length(S);
  1743.   if S[1] = 'T' then I := 2;
  1744.   if (L >= 5) and (CompareText(Copy(S, L - 4, 5), 'FIELD') = 0) then Dec(L, 5);
  1745.   FmtStr(Result, '(%s)', [Copy(S, I, L + 1 - I)]);
  1746.   if not IsNull then Result := AnsiUpperCase(Result);
  1747. end;
  1748.  
  1749. function TField.GetAsVariant: Variant;
  1750. begin
  1751.   raise AccessError('Variant'); { Do not localize }
  1752. end;
  1753.  
  1754. function TField.GetCalculated: Boolean;
  1755. begin
  1756.   Result := FFieldKind = fkCalculated;
  1757. end;
  1758.  
  1759. function TField.GetCanModify: Boolean;
  1760. begin
  1761.   if FieldNo > 0 then
  1762.     if DataSet.State <> dsSetKey then
  1763.       Result := not ReadOnly and DataSet.CanModify else
  1764.       Result := IsIndexField
  1765.   else
  1766.     Result := False;
  1767. end;
  1768.  
  1769. function TField.GetData(Buffer: Pointer): Boolean;
  1770. begin
  1771.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  1772.   if FValidating then
  1773.   begin
  1774.     Result := LongBool(FValueBuffer);
  1775.     if Result and (Buffer <> nil) then
  1776.        Move(FValueBuffer^, Buffer^, DataSize);
  1777.   end else
  1778.     Result := FDataSet.GetFieldData(Self, Buffer);
  1779. end;
  1780.  
  1781. function TField.GetDataSize: Word;
  1782. begin
  1783.   Result := 0;
  1784. end;
  1785.  
  1786. function TField.GetDefaultWidth: Integer;
  1787. begin
  1788.   Result := 10;
  1789. end;
  1790.  
  1791. function TField.GetDisplayLabel: string;
  1792. begin
  1793.   Result := GetDisplayName;
  1794. end;
  1795.  
  1796. function TField.GetDisplayName: string;
  1797. begin
  1798.   if FDisplayLabel <> '' then
  1799.     Result := FDisplayLabel else
  1800.     Result := FFieldName;
  1801. end;
  1802.  
  1803. function TField.GetDisplayText: string;
  1804. begin
  1805.   Result := '';
  1806.   if Assigned(FOnGetText) then
  1807.     FOnGetText(Self, Result, True) else
  1808.     GetText(Result, True);
  1809. end;
  1810.  
  1811. function TField.GetDisplayWidth: Integer;
  1812. begin
  1813.   if FDisplayWidth > 0 then
  1814.     Result := FDisplayWidth else
  1815.     Result := GetDefaultWidth;
  1816. end;
  1817.  
  1818. function TField.GetEditText: string;
  1819. begin
  1820.   Result := '';
  1821.   if Assigned(FOnGetText) then
  1822.     FOnGetText(Self, Result, False) else
  1823.     GetText(Result, False);
  1824. end;
  1825.  
  1826. function TField.GetHasConstraints: Boolean;
  1827. begin
  1828.   Result := (CustomConstraint <> '') or (ImportedConstraint <> '') or
  1829.    (DefaultExpression <> '');
  1830. end;
  1831.  
  1832. function TField.GetIndex: Integer;
  1833. begin
  1834.   if FDataSet <> nil then
  1835.     Result := FDataSet.FFields.IndexOf(Self) else
  1836.     Result := -1;
  1837. end;
  1838.  
  1839. function TField.GetIsIndexField: Boolean;
  1840. begin
  1841.   if FDataSet <> nil then
  1842.     Result := DataSet.GetIsIndexField(Self) else
  1843.     Result := False;
  1844. end;
  1845.  
  1846. class function TField.IsBlob: Boolean;
  1847. begin
  1848.   Result := False;
  1849. end;
  1850.  
  1851. function TField.GetIsNull: Boolean;
  1852. begin
  1853.   Result := not GetData(nil);
  1854. end;
  1855.  
  1856. function TField.GetLookup: Boolean;
  1857. begin
  1858.   Result := FFieldKind = fkLookup;
  1859. end;
  1860.  
  1861. function TField.GetLookupList: TLookupList;
  1862. begin
  1863.   if not Assigned(FLookupList) then
  1864.     FLookupList := TLookupList.Create;
  1865.   Result := FLookupList;
  1866. end;
  1867.  
  1868. procedure TField.GetText(var Text: string; DisplayText: Boolean);
  1869. begin
  1870.   Text := GetAsString;
  1871. end;
  1872.  
  1873. function TField.HasParent: Boolean;
  1874. begin
  1875.   HasParent := True;
  1876. end;
  1877.  
  1878. function TField.GetNewValue: Variant;
  1879. begin
  1880.   Result := DataSet.GetStateFieldValue(dsNewValue, Self);
  1881. end;
  1882.  
  1883. function TField.GetOldValue: Variant;
  1884. begin
  1885.   Result := DataSet.GetStateFieldValue(dsOldValue, Self);
  1886. end;
  1887.  
  1888. function TField.GetCurValue: Variant;
  1889. begin
  1890.   Result := DataSet.GetStateFieldValue(dsCurValue, Self);
  1891. end;
  1892.  
  1893. function TField.GetParentComponent: TComponent;
  1894. begin
  1895.   Result := DataSet;
  1896. end;
  1897.  
  1898. procedure TField.SetParentComponent(AParent: TComponent);
  1899. begin
  1900.   if not (csLoading in ComponentState) then DataSet := AParent as TDataSet;
  1901. end;
  1902.  
  1903. function TField.IsValidChar(InputChar: Char): Boolean;
  1904. begin
  1905.   Result := InputChar in ValidChars;
  1906. end;
  1907.  
  1908. function TField.IsDisplayLabelStored: Boolean;
  1909. begin
  1910.   Result := FDisplayLabel <> '';
  1911. end;
  1912.  
  1913. function TField.IsDisplayWidthStored: Boolean;
  1914. begin
  1915.   Result := FDisplayWidth > 0;
  1916. end;
  1917.  
  1918. procedure TField.Notification(AComponent: TComponent;
  1919.   Operation: TOperation);
  1920. begin
  1921.   inherited Notification(AComponent, Operation);
  1922.   if (Operation = opRemove) and (AComponent = FLookupDataSet) then
  1923.     FLookupDataSet := nil;
  1924. end;
  1925.  
  1926. procedure TField.PropertyChanged(LayoutAffected: Boolean);
  1927. const
  1928.   Events: array[Boolean] of TDataEvent = (deDataSetChange, deLayoutChange);
  1929. begin
  1930.   if (FDataSet <> nil) and FDataSet.Active then
  1931.     FDataSet.DataEvent(Events[LayoutAffected], 0);
  1932. end;
  1933.  
  1934. procedure TField.ReadAttributeSet(Reader: TReader);
  1935. begin
  1936.   FAttributeSet := Reader.ReadString;
  1937. end;
  1938.  
  1939. procedure TField.ReadCalculated(Reader: TReader);
  1940. begin
  1941.   if Reader.ReadBoolean then
  1942.     FFieldKind := fkCalculated;
  1943. end;
  1944.  
  1945. procedure TField.ReadLookup(Reader: TReader);
  1946. begin
  1947.   if Reader.ReadBoolean then
  1948.     FFieldKind := fkLookup;
  1949. end;
  1950.  
  1951. procedure TField.ReadState(Reader: TReader);
  1952. begin
  1953.   inherited ReadState(Reader);
  1954.   if Reader.Parent is TDataSet then DataSet := TDataSet(Reader.Parent);
  1955. end;
  1956.  
  1957. procedure TField.RefreshLookupList;
  1958. var
  1959.   WasActive: Boolean;
  1960. begin
  1961.   if Assigned(FLookupDataSet) then
  1962.   begin
  1963.     WasActive := FLookupDataSet.Active;
  1964.     ValidateLookupInfo(True);
  1965.     with FLookupDataSet do
  1966.     try
  1967.       LookupList.Clear;
  1968.       DisableControls;
  1969.       try
  1970.         First;
  1971.         while not EOF do
  1972.         begin
  1973.           FLookupList.Add(FieldValues[FLookupKeyFields],
  1974.             FieldValues[FLookupResultField]);
  1975.           Next;
  1976.         end;
  1977.       finally
  1978.         EnableControls;
  1979.       end;
  1980.     finally
  1981.       Active := WasActive;
  1982.     end;
  1983.   end
  1984.   else
  1985.     ValidateLookupInfo(False);
  1986. end;
  1987.  
  1988. procedure TField.SetAsBoolean(Value: Boolean);
  1989. begin
  1990.   raise AccessError('Boolean'); { Do not localize }
  1991. end;
  1992.  
  1993. procedure TField.SetAsCurrency(Value: Currency);
  1994. begin
  1995.   SetAsFloat(Value);
  1996. end;
  1997.  
  1998. procedure TField.SetAsDateTime(Value: TDateTime);
  1999. begin
  2000.   raise AccessError('DateTime'); { Do not localize }
  2001. end;
  2002.  
  2003. procedure TField.SetAsFloat(Value: Double);
  2004. begin
  2005.   raise AccessError('Float'); { Do not localize }
  2006. end;
  2007.  
  2008. procedure TField.SetAsInteger(Value: Longint);
  2009. begin
  2010.   raise AccessError('Integer'); { Do not localize }
  2011. end;
  2012.  
  2013. procedure TField.SetAsString(const Value: string);
  2014. begin
  2015.   raise AccessError('String'); { Do not localize }
  2016. end;
  2017.  
  2018. procedure TField.SetAsVariant(const Value: Variant);
  2019. begin
  2020.   if VarIsNull(Value) then
  2021.     Clear
  2022.   else
  2023.     try
  2024.       SetVarValue(Value);
  2025.     except
  2026.       on EVariantError do DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  2027.     end;
  2028. end;
  2029.  
  2030. procedure TField.SetAlignment(Value: TAlignment);
  2031. begin
  2032.   if FAlignment <> Value then
  2033.   begin
  2034.     FAlignment := Value;
  2035.     PropertyChanged(False);
  2036.   end;
  2037. end;
  2038.  
  2039. procedure TField.SetCalculated(Value: Boolean);
  2040. begin
  2041.   if Value then
  2042.     FieldKind := fkCalculated
  2043.   else if FieldKind = fkCalculated then
  2044.     FieldKind := fkData;
  2045. end;
  2046.  
  2047. procedure TField.SetData(Buffer: Pointer);
  2048. begin
  2049.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  2050.   FDataSet.SetFieldData(Self, Buffer);
  2051. end;
  2052.  
  2053. procedure TField.SetDataSet(ADataSet: TDataSet);
  2054. begin
  2055.   if ADataset <> FDataset then
  2056.   begin
  2057.     if FDataSet <> nil then FDataSet.CheckInactive;
  2058.     if ADataSet <> nil then
  2059.     begin
  2060.       ADataSet.CheckInactive;
  2061.       ADataSet.CheckFieldName(FFieldName);
  2062.     end;
  2063.     if FDataSet <> nil then FDataSet.RemoveField(Self);
  2064.     if ADataSet <> nil then ADataSet.AddField(Self);
  2065.   end;
  2066. end;
  2067.  
  2068. procedure TField.SetDataType(Value: TFieldType);
  2069. begin
  2070.   FDataType := Value;
  2071. end;
  2072.  
  2073. procedure TField.SetDisplayLabel(Value: string);
  2074. begin
  2075.   if Value = FFieldName then Value := '';
  2076.   if FDisplayLabel <> Value then
  2077.   begin
  2078.     FDisplaylabel := Value;
  2079.     PropertyChanged(True);
  2080.   end;
  2081. end;
  2082.  
  2083. procedure TField.SetDisplayWidth(Value: Integer);
  2084. begin
  2085.   if FDisplayWidth <> Value then
  2086.   begin
  2087.     FDisplayWidth := Value;
  2088.     PropertyChanged(True);
  2089.   end;
  2090. end;
  2091.  
  2092. procedure TField.SetEditMask(const Value: string);
  2093. begin
  2094.   FEditMask := Value;
  2095.   PropertyChanged(False);
  2096. end;
  2097.  
  2098. procedure TField.SetEditText(const Value: string);
  2099. begin
  2100.   if Assigned(FOnSetText) then FOnSetText(Self, Value) else SetText(Value);
  2101. end;
  2102.  
  2103. procedure TField.SetFieldKind(Value: TFieldKind);
  2104. begin
  2105.   if FFieldKind <> Value then
  2106.   begin
  2107.     if Assigned(DataSet) and Assigned(DataSet.FDesigner) then
  2108.     with DataSet.Designer do
  2109.     begin
  2110.       BeginDesign;
  2111.       try
  2112.         FFieldKind := Value;
  2113.       finally
  2114.         EndDesign;
  2115.       end;
  2116.     end else
  2117.     begin
  2118.       CheckInactive;
  2119.       FFieldKind := Value;
  2120.     end;
  2121.   end;
  2122. end;
  2123.  
  2124. procedure TField.SetFieldName(const Value: string);
  2125. begin
  2126.   CheckInactive;
  2127.   if FDataSet <> nil then FDataSet.CheckFieldName(Value);
  2128.   FFieldName := Value;
  2129.   if FDisplayLabel = Value then FDisplayLabel := '';
  2130.   if FDataSet <> nil then FDataSet.DataEvent(deFieldListChange, 0);
  2131. end;
  2132.  
  2133. procedure TField.SetFieldType(Value: TFieldType);
  2134. begin
  2135. end;
  2136.  
  2137. procedure TField.SetIndex(Value: Integer);
  2138. var
  2139.   CurIndex, Count: Integer;
  2140. begin
  2141.   CurIndex := GetIndex;
  2142.   if CurIndex >= 0 then
  2143.   begin
  2144.     Count := FDataSet.FFields.Count;
  2145.     if Value < 0 then Value := 0;
  2146.     if Value >= Count then Value := Count - 1;
  2147.     if Value <> CurIndex then
  2148.     begin
  2149.       FDataSet.FFields.Delete(CurIndex);
  2150.       FDataSet.FFields.Insert(Value, Self);
  2151.       PropertyChanged(True);
  2152.       FDataSet.DataEvent(deFieldListChange, 0);
  2153.     end;
  2154.   end;
  2155. end;
  2156.  
  2157. procedure TField.SetLookup(Value: Boolean);
  2158. begin
  2159.   if Value then
  2160.     FieldKind := fkLookup
  2161.   else if FieldKind = fkLookup then
  2162.     FieldKind := fkData;
  2163. end;
  2164.  
  2165. procedure TField.SetLookupDataSet(Value: TDataSet);
  2166. begin
  2167.   CheckInactive;
  2168.   if (Value <> nil) and (Value = FDataSet) then DatabaseError(SCircularDataLink);
  2169.   FLookupDataSet := Value;
  2170. end;
  2171.  
  2172. procedure TField.SetLookupKeyFields(const Value: string);
  2173. begin
  2174.   CheckInactive;
  2175.   FLookupKeyFields := Value;
  2176. end;
  2177.  
  2178. procedure TField.SetLookupResultField(const Value: string);
  2179. begin
  2180.   CheckInactive;
  2181.   FLookupResultField := Value;
  2182. end;
  2183.  
  2184. procedure TField.SetKeyFields(const Value: string);
  2185. begin
  2186.   CheckInactive;
  2187.   FKeyFields := Value;
  2188. end;
  2189.  
  2190. procedure TField.SetNewValue(const Value: Variant);
  2191. begin
  2192.   DataSet.SetStateFieldValue(dsNewValue, Self, Value);
  2193. end;
  2194.  
  2195. procedure TField.SetLookupCache(const Value: Boolean);
  2196. begin
  2197.   CheckInactive;
  2198.   FLookupCache := Value;
  2199. end;
  2200.  
  2201. class procedure TField.CheckTypeSize(Value: Integer);
  2202. begin
  2203.   if (Value <> 0) and not IsBlob then DatabaseError(SInvalidFieldSize);
  2204. end;
  2205.  
  2206. procedure TField.SetSize(Value: Word);
  2207. begin
  2208.   CheckInactive;
  2209.   CheckTypeSize(Value);
  2210.   FSize := Value;
  2211. end;
  2212.  
  2213. procedure TField.SetText(const Value: string);
  2214. begin
  2215.   SetAsString(Value);
  2216. end;
  2217.  
  2218. procedure TField.SetVarValue(const Value: Variant);
  2219. begin
  2220.   raise AccessError('Variant'); { Do not localize }
  2221. end;
  2222.  
  2223. procedure TField.SetVisible(Value: Boolean);
  2224. begin
  2225.   if FVisible <> Value then
  2226.   begin
  2227.     FVisible := Value;
  2228.     PropertyChanged(True);
  2229.   end;
  2230. end;
  2231.  
  2232. procedure TField.Validate(Buffer: Pointer);
  2233. begin
  2234.   if Assigned(OnValidate) then
  2235.   begin
  2236.     FValueBuffer := Buffer;
  2237.     FValidating := True;
  2238.     try
  2239.       OnValidate(Self);
  2240.     finally
  2241.       FValidating := False;
  2242.     end;
  2243.   end;
  2244. end;
  2245.  
  2246. procedure TField.ValidateLookupInfo(All: Boolean);
  2247. begin
  2248.   if (All and ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
  2249.      (FLookupResultField = ''))) or (FKeyFields = '') then
  2250.     DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
  2251.   FDataSet.CheckFieldNames(FKeyFields);
  2252.   if All then
  2253.   begin
  2254.     FLookupDataSet.Open;
  2255.     FLookupDataSet.CheckFieldNames(FLookupKeyFields);
  2256.     FLookupDataSet.FieldByName(FLookupResultField);
  2257.   end;
  2258. end;
  2259.  
  2260. procedure TField.WriteAttributeSet(Writer: TWriter);
  2261. begin
  2262.   Writer.WriteString(FAttributeSet);
  2263. end;
  2264.  
  2265. { TStringField }
  2266.  
  2267. constructor TStringField.Create(AOwner: TComponent);
  2268. begin
  2269.   inherited Create(AOwner);
  2270.   SetDataType(ftString);
  2271.   Size := 20;
  2272.   Transliterate := True;
  2273. end;
  2274.  
  2275. class procedure TStringField.CheckTypeSize(Value: Integer);
  2276. begin
  2277.   if (Value < 1) or (Value > dsMaxStringSize) then DatabaseError(SInvalidFieldSize);
  2278. end;
  2279.  
  2280. function TStringField.GetAsBoolean: Boolean;
  2281. var
  2282.   S: string;
  2283. begin
  2284.   S := GetAsString;
  2285.   Result := (Length(S) > 0) and (S[1] in ['T', 't', 'Y', 'y']);
  2286. end;
  2287.  
  2288. function TStringField.GetAsDateTime: TDateTime;
  2289. begin
  2290.   Result := StrToDateTime(GetAsString);
  2291. end;
  2292.  
  2293. function TStringField.GetAsFloat: Double;
  2294. begin
  2295.   Result := StrToFloat(GetAsString);
  2296. end;
  2297.  
  2298. function TStringField.GetAsInteger: Longint;
  2299. begin
  2300.   Result := StrToInt(GetAsString);
  2301. end;
  2302.  
  2303. function TStringField.GetAsString: string;
  2304. begin
  2305.   if not GetValue(Result) then Result := '';
  2306. end;
  2307.  
  2308. function TStringField.GetAsVariant: Variant;
  2309. var
  2310.   S: string;
  2311. begin
  2312.   if GetValue(S) then Result := S else Result := Null;
  2313. end;
  2314.  
  2315. function TStringField.GetDataSize: Word;
  2316. begin
  2317.   Result := Size + 1;
  2318. end;
  2319.  
  2320. function TStringField.GetDefaultWidth: Integer;
  2321. begin
  2322.   Result := Size;
  2323. end;
  2324.  
  2325. procedure TStringField.GetText(var Text: string; DisplayText: Boolean);
  2326. begin
  2327.   if DisplayText and (EditMaskPtr <> '') then
  2328.     Text := FormatMaskText(EditMaskPtr, GetAsString) else
  2329.     Text := GetAsString;
  2330. end;
  2331.  
  2332. function TStringField.GetValue(var Value: string): Boolean;
  2333. var
  2334.   Buffer: array[0..dsMaxStringSize] of Char;
  2335. begin
  2336.   Result := GetData(@Buffer);
  2337.   if Result then
  2338.   begin
  2339.     Value := Buffer;
  2340.     if Transliterate then
  2341.       DataSet.Translate(PChar(Value), PChar(Value), False);
  2342.   end;
  2343. end;
  2344.  
  2345. procedure TStringField.SetAsBoolean(Value: Boolean);
  2346. const
  2347.   Values: array[Boolean] of string[1] = ('F', 'T');
  2348. begin
  2349.   SetAsString(Values[Value]);
  2350. end;
  2351.  
  2352. procedure TStringField.SetAsDateTime(Value: TDateTime);
  2353. begin
  2354.   SetAsString(DateTimeToStr(Value));
  2355. end;
  2356.  
  2357. procedure TStringField.SetAsFloat(Value: Double);
  2358. begin
  2359.   SetAsString(FloatToStr(Value));
  2360. end;
  2361.  
  2362. procedure TStringField.SetAsInteger(Value: Longint);
  2363. begin
  2364.   SetAsString(IntToStr(Value));
  2365. end;
  2366.  
  2367. procedure TStringField.SetAsString(const Value: string);
  2368. var
  2369.   Buffer: array[0..dsMaxStringSize] of Char;
  2370. begin
  2371.   StrLCopy(Buffer, PChar(Value), Size);
  2372.   if Transliterate then
  2373.     DataSet.Translate(Buffer, Buffer, True);
  2374.   SetData(@Buffer);
  2375. end;
  2376.  
  2377. procedure TStringField.SetVarValue(const Value: Variant);
  2378. begin
  2379.   SetAsString(Value);
  2380. end;
  2381.  
  2382. { TNumericField }
  2383.  
  2384. constructor TNumericField.Create(AOwner: TComponent);
  2385. begin
  2386.   inherited Create(AOwner);
  2387.   Alignment := taRightJustify;
  2388. end;
  2389.  
  2390. procedure TNumericField.RangeError(Value, Min, Max: Extended);
  2391. begin
  2392.   DatabaseErrorFmt(SFieldRangeError, [Value, DisplayName, Min, Max]);
  2393. end;
  2394.  
  2395. procedure TNumericField.SetDisplayFormat(const Value: string);
  2396. begin
  2397.   if FDisplayFormat <> Value then
  2398.   begin
  2399.     FDisplayFormat := Value;
  2400.     PropertyChanged(False);
  2401.   end;
  2402. end;
  2403.  
  2404. procedure TNumericField.SetEditFormat(const Value: string);
  2405. begin
  2406.   if FEditFormat <> Value then
  2407.   begin
  2408.     FEditFormat := Value;
  2409.     PropertyChanged(False);
  2410.   end;
  2411. end;
  2412.  
  2413. { TIntegerField }
  2414.  
  2415. constructor TIntegerField.Create(AOwner: TComponent);
  2416. begin
  2417.   inherited Create(AOwner);
  2418.   SetDataType(ftInteger);
  2419.   FMinRange := Low(Longint);
  2420.   FMaxRange := High(Longint);
  2421.   ValidChars := ['+', '-', '0'..'9'];
  2422. end;
  2423.  
  2424. procedure TIntegerField.CheckRange(Value, Min, Max: Longint);
  2425. begin
  2426.   if (Value < Min) or (Value > Max) then RangeError(Value, Min, Max);
  2427. end;
  2428.  
  2429. function TIntegerField.GetAsFloat: Double;
  2430. begin
  2431.   Result := GetAsInteger;
  2432. end;
  2433.  
  2434. function TIntegerField.GetAsInteger: Longint;
  2435. begin
  2436.   if not GetValue(Result) then Result := 0;
  2437. end;
  2438.  
  2439. function TIntegerField.GetAsString: string;
  2440. var
  2441.   L: Longint;
  2442. begin
  2443.   if GetValue(L) then Str(L, Result) else Result := '';
  2444. end;
  2445.  
  2446. function TIntegerField.GetAsVariant: Variant;
  2447. var
  2448.   L: Longint;
  2449. begin
  2450.   if GetValue(L) then Result := L else Result := Null;
  2451. end;
  2452.  
  2453. function TIntegerField.GetDataSize: Word;
  2454. begin
  2455.   Result := SizeOf(Integer);
  2456. end;
  2457.  
  2458. procedure TIntegerField.GetText(var Text: string; DisplayText: Boolean);
  2459. var
  2460.   L: Longint;
  2461.   FmtStr: string;
  2462. begin
  2463.   if GetValue(L) then
  2464.   begin
  2465.     if DisplayText or (FEditFormat = '') then
  2466.       FmtStr := FDisplayFormat else
  2467.       FmtStr := FEditFormat;
  2468.     if FmtStr = '' then Str(L, Text) else Text := FormatFloat(FmtStr, L);
  2469.   end else
  2470.     Text := '';
  2471. end;
  2472.  
  2473. function TIntegerField.GetValue(var Value: Longint): Boolean;
  2474. var
  2475.   Data: record
  2476.     case Integer of
  2477.       0: (I: Smallint);
  2478.       1: (W: Word);
  2479.       2: (L: Longint);
  2480.   end;
  2481. begin
  2482.   Result := GetData(@Data);
  2483.   if Result then
  2484.     case DataType of
  2485.       ftSmallint: Value := Data.I;
  2486.       ftWord: Value := Data.W;
  2487.     else
  2488.       Value := Data.L;
  2489.     end;
  2490. end;
  2491.  
  2492. procedure TIntegerField.SetAsFloat(Value: Double);
  2493. begin
  2494.   SetAsInteger(Round(Value));
  2495. end;
  2496.  
  2497. procedure TIntegerField.SetAsInteger(Value: Longint);
  2498. begin
  2499.   if (FMinValue <> 0) or (FMaxValue <> 0) then
  2500.     CheckRange(Value, FMinValue, FMaxValue) else
  2501.     CheckRange(Value, FMinRange, FMaxRange);
  2502.   SetData(@Value);
  2503. end;
  2504.  
  2505. procedure TIntegerField.SetAsString(const Value: string);
  2506. var
  2507.   E: Integer;
  2508.   L: Longint;
  2509. begin
  2510.   if Value = '' then Clear else
  2511.   begin
  2512.     Val(Value, L, E);
  2513.     if E <> 0 then DatabaseErrorFmt(SInvalidIntegerValue, [Value, DisplayName]);
  2514.     SetAsInteger(L);
  2515.   end;
  2516. end;
  2517.  
  2518. procedure TIntegerField.SetMaxValue(Value: Longint);
  2519. begin
  2520.   CheckRange(Value, FMinRange, FMaxRange);
  2521.   FMaxValue := Value;
  2522. end;
  2523.  
  2524. procedure TIntegerField.SetMinValue(Value: Longint);
  2525. begin
  2526.   CheckRange(Value, FMinRange, FMaxRange);
  2527.   FMinValue := Value;
  2528. end;
  2529.  
  2530. procedure TIntegerField.SetVarValue(const Value: Variant);
  2531. begin
  2532.   SetAsInteger(Value);
  2533. end;
  2534.  
  2535. { TSmallintField }
  2536.  
  2537. constructor TSmallintField.Create(AOwner: TComponent);
  2538. begin
  2539.   inherited Create(AOwner);
  2540.   SetDataType(ftSmallint);
  2541.   FMinRange := Low(Smallint);
  2542.   FMaxRange := High(Smallint);
  2543. end;
  2544.  
  2545. function TSmallintField.GetDataSize: Word;
  2546. begin
  2547.   Result := SizeOf(SmallInt);
  2548. end;
  2549.  
  2550. { TWordField }
  2551.  
  2552. constructor TWordField.Create(AOwner: TComponent);
  2553. begin
  2554.   inherited Create(AOwner);
  2555.   SetDataType(ftWord);
  2556.   FMinRange := Low(Word);
  2557.   FMaxRange := High(Word);
  2558. end;
  2559.  
  2560. function TWordField.GetDataSize: Word;
  2561. begin
  2562.   Result := SizeOf(Word);
  2563. end;
  2564.  
  2565. { TAutoIncField }
  2566.  
  2567. constructor TAutoIncField.Create(AOwner: TComponent);
  2568. begin
  2569.   inherited Create(AOwner);
  2570.   SetDataType(ftAutoInc);
  2571. end;
  2572.  
  2573. { TFloatField }
  2574.  
  2575. constructor TFloatField.Create(AOwner: TComponent);
  2576. begin
  2577.   inherited Create(AOwner);
  2578.   SetDataType(ftFloat);
  2579.   FPrecision := 15;
  2580.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
  2581. end;
  2582.  
  2583. function TFloatField.GetAsFloat: Double;
  2584. begin
  2585.   if not GetData(@Result) then Result := 0;
  2586. end;
  2587.  
  2588. function TFloatField.GetAsInteger: Longint;
  2589. begin
  2590.   Result := Round(GetAsFloat);
  2591. end;
  2592.  
  2593. function TFloatField.GetAsString: string;
  2594. var
  2595.   F: Double;
  2596. begin
  2597.   if GetData(@F) then Result := FloatToStr(F) else Result := '';
  2598. end;
  2599.  
  2600. function TFloatField.GetAsVariant: Variant;
  2601. var
  2602.   F: Double;
  2603. begin
  2604.   if GetData(@F) then Result := F else Result := Null;
  2605. end;
  2606.  
  2607. function TFloatField.GetDataSize: Word;
  2608. begin
  2609.   Result := SizeOf(Double);
  2610. end;
  2611.  
  2612. procedure TFloatField.GetText(var Text: string; DisplayText: Boolean);
  2613. var
  2614.   Format: TFloatFormat;
  2615.   Digits: Integer;
  2616.   FmtStr: string;
  2617.   F: Double;
  2618. begin
  2619.   if GetData(@F) then
  2620.   begin
  2621.     if DisplayText or (FEditFormat = '') then
  2622.       FmtStr := FDisplayFormat else
  2623.       FmtStr := FEditFormat;
  2624.     if FmtStr = '' then
  2625.     begin
  2626.       if FCurrency then
  2627.       begin
  2628.         if DisplayText then Format := ffCurrency else Format := ffFixed;
  2629.         Digits := CurrencyDecimals;
  2630.       end
  2631.       else begin
  2632.         Format := ffGeneral;
  2633.         Digits := 0;
  2634.       end;
  2635.       Text := FloatToStrF(F, Format, FPrecision, Digits);
  2636.     end else
  2637.       Text := FormatFloat(FmtStr, F);
  2638.   end else
  2639.     Text := '';
  2640. end;
  2641.  
  2642. procedure TFloatField.SetAsFloat(Value: Double);
  2643. begin
  2644.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  2645.     RangeError(Value, FMinValue, FMaxValue);
  2646.   SetData(@Value);
  2647. end;
  2648.  
  2649. procedure TFloatField.SetAsInteger(Value: Longint);
  2650. begin
  2651.   SetAsFloat(Value);
  2652. end;
  2653.  
  2654. procedure TFloatField.SetAsString(const Value: string);
  2655. var
  2656.   F: Extended;
  2657. begin
  2658.   if Value = '' then Clear else
  2659.   begin
  2660.     if not TextToFloat(PChar(Value), F, fvExtended) then
  2661.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  2662.     SetAsFloat(F);
  2663.   end;
  2664. end;
  2665.  
  2666. procedure TFloatField.SetCurrency(Value: Boolean);
  2667. begin
  2668.   if FCurrency <> Value then
  2669.   begin
  2670.     FCurrency := Value;
  2671.     PropertyChanged(False);
  2672.   end;
  2673. end;
  2674.  
  2675. procedure TFloatField.SetMaxValue(Value: Double);
  2676. begin
  2677.   FMaxValue := Value;
  2678.   UpdateCheckRange;
  2679. end;
  2680.  
  2681. procedure TFloatField.SetMinValue(Value: Double);
  2682. begin
  2683.   FMinValue := Value;
  2684.   UpdateCheckRange;
  2685. end;
  2686.  
  2687. procedure TFloatField.SetPrecision(Value: Integer);
  2688. begin
  2689.   if Value < 2 then Value := 2;
  2690.   if Value > 15 then Value := 15;
  2691.   if FPrecision <> Value then
  2692.   begin
  2693.     FPrecision := Value;
  2694.     PropertyChanged(False);
  2695.   end;
  2696. end;
  2697.  
  2698. procedure TFloatField.SetVarValue(const Value: Variant);
  2699. begin
  2700.   SetAsFloat(Value);
  2701. end;
  2702.  
  2703. procedure TFloatField.UpdateCheckRange;
  2704. begin
  2705.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  2706. end;
  2707.  
  2708. { TCurrencyField }
  2709.  
  2710. constructor TCurrencyField.Create(AOwner: TComponent);
  2711. begin
  2712.   inherited Create(AOwner);
  2713.   SetDataType(ftCurrency);
  2714.   FCurrency := True;
  2715. end;
  2716.  
  2717. { TBooleanField }
  2718.  
  2719. constructor TBooleanField.Create(AOwner: TComponent);
  2720. begin
  2721.   inherited Create(AOwner);
  2722.   SetDataType(ftBoolean);
  2723.   LoadTextValues;
  2724. end;
  2725.  
  2726. function TBooleanField.GetAsBoolean: Boolean;
  2727. var
  2728.   B: WordBool;
  2729. begin
  2730.   if GetData(@B) then Result := B else Result := False;
  2731. end;
  2732.  
  2733. function TBooleanField.GetAsString: string;
  2734. var
  2735.   B: Bool;
  2736. begin
  2737.   if GetData(@B) then Result := FTextValues[Boolean(B)] else Result := '';
  2738. end;
  2739.  
  2740. function TBooleanField.GetAsVariant: Variant;
  2741. var
  2742.   B: WordBool;
  2743. begin
  2744.   if GetData(@B) then Result := B else Result := Null;
  2745. end;
  2746.  
  2747. function TBooleanField.GetDataSize: Word;
  2748. begin
  2749.   Result := SizeOf(WordBool);
  2750. end;
  2751.  
  2752. function TBooleanField.GetDefaultWidth: Integer;
  2753. begin
  2754.   if Length(FTextValues[False]) > Length(FTextValues[True]) then
  2755.     Result := Length(FTextValues[False]) else
  2756.     Result := Length(FTextValues[True]);
  2757. end;
  2758.  
  2759. procedure TBooleanField.LoadTextValues;
  2760. begin
  2761.   FTextValues[False] := STextFalse;
  2762.   FTextValues[True] := STextTrue;
  2763. end;
  2764.  
  2765. procedure TBooleanField.SetAsBoolean(Value: Boolean);
  2766. var
  2767.   B: WordBool;
  2768. begin
  2769.   if Value then Word(B) := 1 else Word(B) := 0;
  2770.   SetData(@B);
  2771. end;
  2772.  
  2773. procedure TBooleanField.SetAsString(const Value: string);
  2774. var
  2775.   L: Integer;
  2776. begin
  2777.   L := Length(Value);
  2778.   if L = 0 then
  2779.   begin
  2780.     if Length(FTextValues[False]) = 0 then SetAsBoolean(False) else
  2781.       if Length(FTextValues[True]) = 0 then SetAsBoolean(True) else
  2782.         Clear;
  2783.   end else
  2784.   begin
  2785.     if AnsiCompareText(Value, Copy(FTextValues[False], 1, L)) = 0 then
  2786.       SetAsBoolean(False)
  2787.     else
  2788.       if AnsiCompareText(Value, Copy(FTextValues[True], 1, L)) = 0 then
  2789.         SetAsBoolean(True)
  2790.       else
  2791.         DatabaseErrorFmt(SInvalidBoolValue, [Value, DisplayName]);
  2792.   end;
  2793. end;
  2794.  
  2795. procedure TBooleanField.SetDisplayValues(const Value: string);
  2796. var
  2797.   P: Integer;
  2798. begin
  2799.   if FDisplayValues <> Value then
  2800.   begin
  2801.     FDisplayValues := Value;
  2802.     if Value = '' then LoadTextValues else
  2803.     begin
  2804.       P := Pos(';', Value);
  2805.       if P = 0 then P := 256;
  2806.       FTextValues[False] := Copy(Value, P + 1, 255);
  2807.       FTextValues[True] := Copy(Value, 1, P - 1);
  2808.     end;
  2809.     PropertyChanged(True);
  2810.   end;
  2811. end;
  2812.  
  2813. procedure TBooleanField.SetVarValue(const Value: Variant);
  2814. begin
  2815.   SetAsBoolean(Value);
  2816. end;
  2817.  
  2818. { TDateTimeField }
  2819.  
  2820. constructor TDateTimeField.Create(AOwner: TComponent);
  2821. begin
  2822.   inherited Create(AOwner);
  2823.   SetDataType(ftDateTime);
  2824. end;
  2825.  
  2826. function TDateTimeField.GetAsDateTime: TDateTime;
  2827. begin
  2828.   if not GetValue(Result) then Result := 0;
  2829. end;
  2830.  
  2831. function TDateTimeField.GetAsFloat: Double;
  2832. begin
  2833.   Result := GetAsDateTime;
  2834. end;
  2835.  
  2836. function TDateTimeField.GetAsString: string;
  2837. begin
  2838.   GetText(Result, False);
  2839. end;
  2840.  
  2841. function TDateTimeField.GetAsVariant: Variant;
  2842. var
  2843.   D: TDateTime;
  2844. begin
  2845.   if GetValue(D) then Result := VarFromDateTime(D) else Result := Null;
  2846. end;
  2847.  
  2848. function TDateTimeField.GetDataSize: Word;
  2849. begin
  2850.   Result := SizeOf(TDateTime);
  2851. end;
  2852.  
  2853. procedure TDateTimeField.GetText(var Text: string; DisplayText: Boolean);
  2854. var
  2855.   F: string;
  2856.   D: TDateTime;
  2857. begin
  2858.   if GetValue(D) then
  2859.   begin
  2860.     if DisplayText and (FDisplayFormat <> '') then
  2861.       F := FDisplayFormat
  2862.     else
  2863.       case DataType of
  2864.         ftDate: F := ShortDateFormat;
  2865.         ftTime: F := LongTimeFormat;
  2866.       end;
  2867.     DateTimeToString(Text, F, D);
  2868.   end else
  2869.     Text := '';
  2870. end;
  2871.  
  2872. function TDateTimeField.GetValue(var Value: TDateTime): Boolean;
  2873. var
  2874.   TimeStamp: TTimeStamp;
  2875.   Data: TDateTimeRec;
  2876. begin
  2877.   Result := GetData(@Data);
  2878.   if Result then
  2879.   begin
  2880.     case DataType of
  2881.       ftDate:
  2882.         begin
  2883.           TimeStamp.Time := 0;
  2884.           TimeStamp.Date := Data.Date;
  2885.         end;
  2886.       ftTime:
  2887.         begin
  2888.           TimeStamp.Time := Data.Time;
  2889.           TimeStamp.Date := DateDelta;
  2890.         end;
  2891.     else
  2892.       try
  2893.         TimeStamp := MSecsToTimeStamp(Data.DateTime);
  2894.       except
  2895.         TimeStamp.Time := 0;
  2896.         TimeStamp.Date := 0;
  2897.       end;
  2898.     end;
  2899.     Value := TimeStampToDateTime(TimeStamp);
  2900.   end;
  2901. end;
  2902.  
  2903. procedure TDateTimeField.SetAsDateTime(Value: TDateTime);
  2904. var
  2905.   TimeStamp: TTimeStamp;
  2906.   Data: TDateTimeRec;
  2907. begin
  2908.   TimeStamp := DateTimeToTimeStamp(Value);
  2909.   case DataType of
  2910.     ftDate: Data.Date := TimeStamp.Date;
  2911.     ftTime: Data.Time := TimeStamp.Time;
  2912.   else
  2913.     Data.DateTime := TimeStampToMSecs(TimeStamp);
  2914.   end;
  2915.   SetData(@Data);
  2916. end;
  2917.  
  2918. procedure TDateTimeField.SetAsFloat(Value: Double);
  2919. begin
  2920.   SetAsDateTime(Value);
  2921. end;
  2922.  
  2923. procedure TDateTimeField.SetAsString(const Value: string);
  2924. var
  2925.   DateTime: TDateTime;
  2926. begin
  2927.   if Value = '' then Clear else
  2928.   begin
  2929.     case DataType of
  2930.       ftDate: DateTime := StrToDate(Value);
  2931.       ftTime: DateTime := StrToTime(Value);
  2932.     else
  2933.       DateTime := StrToDateTime(Value);
  2934.     end;
  2935.     SetAsDateTime(DateTime);
  2936.   end;
  2937. end;
  2938.  
  2939. procedure TDateTimeField.SetDisplayFormat(const Value: string);
  2940. begin
  2941.   if FDisplayFormat <> Value then
  2942.   begin
  2943.     FDisplayFormat := Value;
  2944.     PropertyChanged(False);
  2945.   end;
  2946. end;
  2947.  
  2948. procedure TDateTimeField.SetVarValue(const Value: Variant);
  2949. begin
  2950.   SetAsDateTime(VarToDateTime(Value));
  2951. end;
  2952.  
  2953. { TDateField }
  2954.  
  2955. constructor TDateField.Create(AOwner: TComponent);
  2956. begin
  2957.   inherited Create(AOwner);
  2958.   SetDataType(ftDate);
  2959. end;
  2960.  
  2961. function TDateField.GetDataSize: Word;
  2962. begin
  2963.   Result := SizeOf(Integer);
  2964. end;
  2965.  
  2966. { TTimeField }
  2967.  
  2968. constructor TTimeField.Create(AOwner: TComponent);
  2969. begin
  2970.   inherited Create(AOwner);
  2971.   SetDataType(ftTime);
  2972. end;
  2973.  
  2974. function TTimeField.GetDataSize: Word;
  2975. begin
  2976.   Result := SizeOf(Integer);
  2977. end;
  2978.  
  2979. { TBinaryField }
  2980.  
  2981. constructor TBinaryField.Create(AOwner: TComponent);
  2982. begin
  2983.   inherited Create(AOwner);
  2984. end;
  2985.  
  2986. class procedure TBinaryField.CheckTypeSize(Value: Integer);
  2987. begin
  2988.   if (Value = 0) then DatabaseError(SInvalidFieldSize);
  2989. end;
  2990.  
  2991. function TBinaryField.GetAsVariant: Variant;
  2992. var
  2993.   Data: Pointer;
  2994. begin
  2995.   Result := VarArrayCreate([0, DataSize - 1], varByte);
  2996.   Data := VarArrayLock(Result);
  2997.   try
  2998.     GetData(Data);
  2999.   finally
  3000.     VarArrayUnlock(Result);
  3001.   end;
  3002. end;
  3003.  
  3004. procedure TBinaryField.SetVarValue(const Value: Variant);
  3005. var
  3006.   Data: Pointer;
  3007. begin
  3008.   if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
  3009.     ((VarType(Value) and VarTypeMask) = varByte) and
  3010.     ((VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1) = DataSize)) then
  3011.     DatabaseError(SInvalidVarByteArray);
  3012.   Data := VarArrayLock(Value);
  3013.   try
  3014.     SetData(Data);
  3015.   finally
  3016.     VarArrayUnlock(Value);
  3017.   end;
  3018. end;
  3019.  
  3020. { TBytesField }
  3021.  
  3022. constructor TBytesField.Create(AOwner: TComponent);
  3023. begin
  3024.   inherited Create(AOwner);
  3025.   SetDataType(ftBytes);
  3026.   Size := 16;
  3027. end;
  3028.  
  3029. function TBytesField.GetDataSize: Word;
  3030. begin
  3031.   Result := Size;
  3032. end;
  3033.  
  3034. { TVarBytesField }
  3035.  
  3036. constructor TVarBytesField.Create(AOwner: TComponent);
  3037. begin
  3038.   inherited Create(AOwner);
  3039.   SetDataType(ftVarBytes);
  3040.   Size := 16;
  3041. end;
  3042.  
  3043. function TVarBytesField.GetDataSize: Word;
  3044. begin
  3045.   Result := Size + 2;
  3046. end;
  3047.  
  3048. { TBCDField }
  3049.  
  3050. constructor TBCDField.Create(AOwner: TComponent);
  3051. begin
  3052.   inherited Create(AOwner);
  3053.   SetDataType(ftBCD);
  3054.   Size := 4;
  3055.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
  3056. end;
  3057.  
  3058. class procedure TBCDField.CheckTypeSize(Value: Integer);
  3059. begin
  3060.   if Value > 32 then DatabaseError(SInvalidFieldSize);
  3061. end;
  3062.  
  3063. function TBCDField.GetAsCurrency: Currency;
  3064. begin
  3065.   if not GetValue(Result) then Result := 0;
  3066. end;
  3067.  
  3068. function TBCDField.GetAsFloat: Double;
  3069. begin
  3070.   Result := GetAsCurrency;
  3071. end;
  3072.  
  3073. function TBCDField.GetAsInteger: Longint;
  3074. begin
  3075.   Result := Round(GetAsCurrency);
  3076. end;
  3077.  
  3078. function TBCDField.GetAsString: string;
  3079. var
  3080.   C: System.Currency;
  3081. begin
  3082.   if GetValue(C) then Result := CurrToStr(C) else Result := '';
  3083. end;
  3084.  
  3085. function TBCDField.GetAsVariant: Variant;
  3086. var
  3087.   C: System.Currency;
  3088. begin
  3089.   if GetValue(C) then Result := C else Result := Null;
  3090. end;
  3091.  
  3092. function TBCDField.GetDataSize: Word;
  3093. begin
  3094.   Result := 34;
  3095. end;
  3096.  
  3097. procedure TBCDField.GetText(var Text: string; DisplayText: Boolean);
  3098. var
  3099.   Format: TFloatFormat;
  3100.   Digits: Integer;
  3101.   FmtStr: string;
  3102.   BCD: array[0..255] of Byte;
  3103.   C: System.Currency;
  3104. begin
  3105.   if GetData(@BCD) then
  3106.     if DataSet.BCDToCurr(@BCD, C) then
  3107.     begin
  3108.       if DisplayText or (EditFormat = '') then
  3109.         FmtStr := DisplayFormat else
  3110.         FmtStr := EditFormat;
  3111.       if FmtStr = '' then
  3112.       begin
  3113.         if FCurrency then
  3114.         begin
  3115.           if DisplayText then Format := ffCurrency else Format := ffFixed;
  3116.           Digits := CurrencyDecimals;
  3117.         end
  3118.         else begin
  3119.           Format := ffGeneral;
  3120.           Digits := 0;
  3121.         end;
  3122.         Text := CurrToStrF(C, Format, Digits);
  3123.       end else
  3124.         Text := FormatCurr(FmtStr, C);
  3125.     end else
  3126.       Text := SBCDOverflow
  3127.   else
  3128.     Text := '';
  3129. end;
  3130.  
  3131. function TBCDField.GetValue(var Value: Currency): Boolean;
  3132. var
  3133.   BCD: array[0..255] of Byte;
  3134. begin
  3135.   Result := GetData(@BCD);
  3136.   if Result then
  3137.     if not FDataSet.BCDToCurr(@BCD, Value) then
  3138.       DatabaseErrorFmt(SFieldOutOfRange, [DisplayName]);
  3139. end;
  3140.  
  3141. procedure TBCDField.SetAsCurrency(Value: Currency);
  3142. var
  3143.   BCD: array[0..255] of Byte;
  3144. begin
  3145.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  3146.     RangeError(Value, FMinValue, FMaxValue);
  3147.   FDataSet.CurrToBCD(Value, @BCD, 32, Size);
  3148.   SetData(@BCD);
  3149. end;
  3150.  
  3151. procedure TBCDField.SetAsFloat(Value: Double);
  3152. begin
  3153.   SetAsCurrency(Value);
  3154. end;
  3155.  
  3156. procedure TBCDField.SetAsInteger(Value: Longint);
  3157. begin
  3158.   SetAsCurrency(Value);
  3159. end;
  3160.  
  3161. procedure TBCDField.SetAsString(const Value: string);
  3162. var
  3163.   C: System.Currency;
  3164. begin
  3165.   if Value = '' then Clear else
  3166.   begin
  3167.     if not TextToFloat(PChar(Value), C, fvCurrency) then
  3168.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  3169.     SetAsCurrency(C);
  3170.   end;
  3171. end;
  3172.  
  3173. procedure TBCDField.SetCurrency(Value: Boolean);
  3174. begin
  3175.   if FCurrency <> Value then
  3176.   begin
  3177.     FCurrency := Value;
  3178.     PropertyChanged(False);
  3179.   end;
  3180. end;
  3181.  
  3182. procedure TBCDField.SetMaxValue(Value: Currency);
  3183. begin
  3184.   FMaxValue := Value;
  3185.   UpdateCheckRange;
  3186. end;
  3187.  
  3188. procedure TBCDField.SetMinValue(Value: Currency);
  3189. begin
  3190.   FMinValue := Value;
  3191.   UpdateCheckRange;
  3192. end;
  3193.  
  3194. procedure TBCDField.SetVarValue(const Value: Variant);
  3195. begin
  3196.   SetAsCurrency(Value);
  3197. end;
  3198.  
  3199. procedure TBCDField.UpdateCheckRange;
  3200. begin
  3201.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  3202. end;
  3203.  
  3204. { TBlobField }
  3205.  
  3206. constructor TBlobField.Create(AOwner: TComponent);
  3207. begin
  3208.   inherited Create(AOwner);
  3209.   SetDataType(ftBlob);
  3210. end;
  3211.  
  3212. procedure TBlobField.Assign(Source: TPersistent);
  3213. begin
  3214.   if Source is TBlobField then
  3215.   begin
  3216.     LoadFromBlob(TBlobField(Source));
  3217.     Exit;
  3218.   end;
  3219.   if Source is TStrings then
  3220.   begin
  3221.     LoadFromStrings(TStrings(Source));
  3222.     Exit;
  3223.   end;
  3224.   if Source is TBitmap then
  3225.   begin
  3226.     LoadFromBitmap(TBitmap(Source));
  3227.     Exit;
  3228.   end;
  3229.   if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then
  3230.   begin
  3231.     LoadFromBitmap(TBitmap(TPicture(Source).Graphic));
  3232.     Exit;
  3233.   end;
  3234.   inherited Assign(Source);
  3235. end;
  3236.  
  3237. procedure TBlobField.AssignTo(Dest: TPersistent);
  3238. begin
  3239.   if Dest is TStrings then
  3240.   begin
  3241.     SaveToStrings(TStrings(Dest));
  3242.     Exit;
  3243.   end;
  3244.   if Dest is TBitmap then
  3245.   begin
  3246.     SaveToBitmap(TBitmap(Dest));
  3247.     Exit;
  3248.   end;
  3249.   if Dest is TPicture then
  3250.   begin
  3251.     SaveToBitmap(TPicture(Dest).Bitmap);
  3252.     Exit;
  3253.   end;
  3254.   inherited AssignTo(Dest);
  3255. end;
  3256.  
  3257. procedure TBlobField.Clear;
  3258. begin
  3259.   DataSet.CreateBlobStream(Self, bmWrite).Free;
  3260. end;
  3261.  
  3262. procedure TBlobField.FreeBuffers;
  3263. begin
  3264.   if FModified then
  3265.   begin
  3266.     Dataset.CloseBlob(Self);
  3267.     FModified := False;
  3268.   end;
  3269. end;
  3270.  
  3271. function TBlobField.GetAsString: string;
  3272. var
  3273.   Len: Integer;
  3274. begin
  3275.   with DataSet.CreateBlobStream(Self, bmRead) do
  3276.     try
  3277.       Len := Size;
  3278.       SetString(Result, nil, Len);
  3279.       ReadBuffer(Pointer(Result)^, Len);
  3280.     finally
  3281.       Free;
  3282.     end;
  3283. end;
  3284.  
  3285. function TBlobField.GetAsVariant: Variant;
  3286. begin
  3287.   Result := GetAsString;
  3288. end;
  3289.  
  3290. function TBlobField.GetBlobType: TBlobType;
  3291. begin
  3292.   Result := TBlobType(DataType);
  3293. end;
  3294.  
  3295. class function TBlobField.IsBlob: Boolean;
  3296. begin
  3297.   Result := True;
  3298. end;
  3299.  
  3300. function TBlobField.GetIsNull: Boolean;
  3301. begin
  3302.   if Modified then
  3303.   begin
  3304.     with DataSet.CreateBlobStream(Self, bmRead) do
  3305.     try
  3306.       Result := (Size = 0);
  3307.     finally
  3308.       Free;
  3309.     end;
  3310.   end else
  3311.     Result := inherited GetIsNull;
  3312. end;
  3313.  
  3314. function TBlobField.GetModified: Boolean;
  3315. begin
  3316.   Result := FModified and (FModifiedRecord = DataSet.ActiveRecord);
  3317. end;
  3318.  
  3319. procedure TBlobField.GetText(var Text: string; DisplayText: Boolean);
  3320. begin
  3321.   Text := inherited GetAsString;
  3322. end;
  3323.  
  3324. procedure TBlobField.LoadFromBitmap(Bitmap: TBitmap);
  3325. var
  3326.   BlobStream: TStream;
  3327.   Header: TGraphicHeader;
  3328. begin
  3329.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3330.   try
  3331.     if (DataType = ftGraphic) or (DataType = ftTypedBinary) then
  3332.     begin
  3333.       Header.Count := 1;
  3334.       Header.HType := $0100;
  3335.       Header.Size := 0;
  3336.       BlobStream.Write(Header, SizeOf(Header));
  3337.       Bitmap.SaveToStream(BlobStream);
  3338.       Header.Size := BlobStream.Position - SizeOf(Header);
  3339.       BlobStream.Position := 0;
  3340.       BlobStream.Write(Header, SizeOf(Header));
  3341.     end else
  3342.       Bitmap.SaveToStream(BlobStream);
  3343.   finally
  3344.     BlobStream.Free;
  3345.   end;
  3346. end;
  3347.  
  3348. procedure TBlobField.LoadFromBlob(Blob: TBlobField);
  3349. var
  3350.   BlobStream: TStream;
  3351. begin
  3352.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3353.   try
  3354.     Blob.SaveToStream(BlobStream);
  3355.   finally
  3356.     BlobStream.Free;
  3357.   end;
  3358. end;
  3359.  
  3360. procedure TBlobField.LoadFromFile(const FileName: string);
  3361. var
  3362.   Stream: TStream;
  3363. begin
  3364.   Stream := TFileStream.Create(FileName, fmOpenRead);
  3365.   try
  3366.     LoadFromStream(Stream);
  3367.   finally
  3368.     Stream.Free;
  3369.   end;
  3370. end;
  3371.  
  3372. procedure TBlobField.LoadFromStream(Stream: TStream);
  3373. begin
  3374.   with DataSet.CreateBlobStream(Self, bmWrite) do
  3375.   try
  3376.     CopyFrom(Stream, 0);
  3377.   finally
  3378.     Free;
  3379.   end;
  3380. end;
  3381.  
  3382. procedure TBlobField.LoadFromStrings(Strings: TStrings);
  3383. var
  3384.   BlobStream: TStream;
  3385. begin
  3386.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3387.   try
  3388.     Strings.SaveToStream(BlobStream);
  3389.   finally
  3390.     BlobStream.Free;
  3391.   end;
  3392. end;
  3393.  
  3394. procedure TBlobField.SaveToBitmap(Bitmap: TBitmap);
  3395. var
  3396.   BlobStream: TStream;
  3397.   Size: Longint;
  3398.   Header: TGraphicHeader;
  3399. begin
  3400.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3401.   try
  3402.     Size := BlobStream.Size;
  3403.     if Size >= SizeOf(TGraphicHeader) then
  3404.     begin
  3405.       BlobStream.Read(Header, SizeOf(Header));
  3406.       if (Header.Count <> 1) or (Header.HType <> $0100) or
  3407.         (Header.Size <> Size - SizeOf(Header)) then
  3408.         BlobStream.Position := 0;
  3409.     end;
  3410.     Bitmap.LoadFromStream(BlobStream);
  3411.   finally
  3412.     BlobStream.Free;
  3413.   end;
  3414. end;
  3415.  
  3416. procedure TBlobField.SaveToFile(const FileName: string);
  3417. var
  3418.   Stream: TStream;
  3419. begin
  3420.   Stream := TFileStream.Create(FileName, fmCreate);
  3421.   try
  3422.     SaveToStream(Stream);
  3423.   finally
  3424.     Stream.Free;
  3425.   end;
  3426. end;
  3427.  
  3428. procedure TBlobField.SaveToStream(Stream: TStream);
  3429. var
  3430.   BlobStream: TStream;
  3431. begin
  3432.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3433.   try
  3434.     Stream.CopyFrom(BlobStream, 0);
  3435.   finally
  3436.     BlobStream.Free;
  3437.   end;
  3438. end;
  3439.  
  3440. procedure TBlobField.SaveToStrings(Strings: TStrings);
  3441. var
  3442.   BlobStream: TStream;
  3443. begin
  3444.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3445.   try
  3446.     Strings.LoadFromStream(BlobStream);
  3447.   finally
  3448.     BlobStream.Free;
  3449.   end;
  3450. end;
  3451.  
  3452. procedure TBlobField.SetAsString(const Value: string);
  3453. begin
  3454.   with DataSet.CreateBlobStream(Self, bmWrite) do
  3455.     try
  3456.       WriteBuffer(Pointer(Value)^, Length(Value));
  3457.     finally
  3458.       Free;
  3459.     end;
  3460. end;
  3461.  
  3462. procedure TBlobField.SetBlobType(Value: TBlobType);
  3463. begin
  3464.   SetFieldType(Value);
  3465. end;
  3466.  
  3467. procedure TBlobField.SetFieldType(Value: TFieldType);
  3468. begin
  3469.   if Value in [Low(TBlobType)..High(TBlobType)] then SetDataType(Value);
  3470. end;
  3471.  
  3472. procedure TBlobField.SetModified(Value: Boolean);
  3473. begin
  3474.   FModified := Value;
  3475.   if FModified then
  3476.     FModifiedRecord := DataSet.ActiveRecord;
  3477. end;
  3478.  
  3479. procedure TBlobField.SetText(const Value: string);
  3480. begin
  3481.   raise AccessError('Text');
  3482. end;
  3483.  
  3484. procedure TBlobField.SetVarValue(const Value: Variant);
  3485. begin
  3486.   SetAsString(Value);
  3487. end;
  3488.  
  3489. { TMemoField }
  3490.  
  3491. constructor TMemoField.Create(AOwner: TComponent);
  3492. begin
  3493.   inherited Create(AOwner);
  3494.   SetDataType(ftMemo);
  3495.   Transliterate := True;
  3496. end;
  3497.  
  3498. { TGraphicField }
  3499.  
  3500. constructor TGraphicField.Create(AOwner: TComponent);
  3501. begin
  3502.   inherited Create(AOwner);
  3503.   SetDataType(ftGraphic);
  3504. end;
  3505.  
  3506. { TIndexDef }
  3507.  
  3508. constructor TIndexDef.Create(Owner: TIndexDefs; const Name, Fields: string;
  3509.   Options: TIndexOptions);
  3510. begin
  3511.   if Owner <> nil then
  3512.   begin
  3513.     Owner.FItems.Add(Self);
  3514.     Owner.FUpdated := False;
  3515.     FOwner := Owner;
  3516.   end;
  3517.   FName := Name;
  3518.   FFields := Fields;
  3519.   FOptions := Options;
  3520. end;
  3521.  
  3522. destructor TIndexDef.Destroy;
  3523. begin
  3524.   if FOwner <> nil then
  3525.   begin
  3526.     FOwner.FItems.Remove(Self);
  3527.     FOwner.FUpdated := False;
  3528.   end;
  3529. end;
  3530.  
  3531. function TIndexDef.GetExpression: string;
  3532. begin
  3533.   if ixExpression in Options then Result := FFields else Result := '';
  3534. end;
  3535.  
  3536. function TIndexDef.GetFields: string;
  3537. begin
  3538.   if ixExpression in Options then Result := '' else Result := FFields;
  3539. end;
  3540.  
  3541. { TIndexDefs }
  3542.  
  3543. constructor TIndexDefs.Create(DataSet: TDataSet);
  3544. begin
  3545.   FDataSet := DataSet;
  3546.   FItems := TList.Create;
  3547. end;
  3548.  
  3549. destructor TIndexDefs.Destroy;
  3550. begin
  3551.   if FItems <> nil then Clear;
  3552.   FItems.Free;
  3553. end;
  3554.  
  3555. procedure TIndexDefs.Add(const Name, Fields: string;
  3556.   Options: TIndexOptions);
  3557. begin
  3558.   if IndexOf(Name) >= 0 then DatabaseErrorFmt(SDuplicateIndexName, [Name]);
  3559.   TIndexDef.Create(Self, Name, Fields, Options);
  3560. end;
  3561.  
  3562. procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
  3563. var
  3564.   I: Integer;
  3565. begin
  3566.   Clear;
  3567.   for I := 0 to IndexDefs.Count - 1 do
  3568.     with IndexDefs[I] do Add(Name, Fields, Options);
  3569. end;
  3570.  
  3571. procedure TIndexDefs.Clear;
  3572. begin
  3573.   while FItems.Count > 0 do TIndexDef(FItems.Last).Free;
  3574. end;
  3575.  
  3576. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  3577. begin
  3578.   Result := GetIndexForFields(Fields, False);
  3579.   if Result = nil then
  3580.     DatabaseErrorFmt(SNoIndexForFields, [FDataSet.Name, Fields]);
  3581. end;
  3582.  
  3583. function TIndexDefs.GetCount: Integer;
  3584. begin
  3585.   Result := FItems.Count;
  3586. end;
  3587.  
  3588. function TIndexDefs.GetIndexForFields(const Fields: string;
  3589.   CaseInsensitive: Boolean): TIndexDef;
  3590. var
  3591.   Exact: Boolean;
  3592.   I, L: Integer;
  3593. begin
  3594.   Update;
  3595.   L := Length(Fields);
  3596.   Exact := True;
  3597.   while True do
  3598.   begin
  3599.     for I := 0 to FItems.Count - 1 do
  3600.     begin
  3601.       Result := FItems[I];
  3602.       if (Result.FOptions * [ixDescending, ixExpression] = []) and
  3603.         (not CaseInsensitive or (ixCaseInsensitive in Result.FOptions)) then
  3604.         if Exact then
  3605.         begin
  3606.           if AnsiCompareText(Fields, Result.Fields) = 0 then Exit;
  3607.         end
  3608.         else begin
  3609.           if (AnsiCompareText(Fields, Copy(Result.Fields, 1, L)) = 0) and
  3610.             ((Length(Result.FFields) = L) or
  3611.             (Result.FFields[L + 1] = ';')) then Exit;
  3612.         end;
  3613.     end;
  3614.     if not Exact then Break;
  3615.     Exact := False;
  3616.   end;
  3617.   Result := nil;
  3618. end;
  3619.  
  3620. function TIndexDefs.GetItem(Index: Integer): TIndexDef;
  3621. begin
  3622.   Result := FItems[Index];
  3623. end;
  3624.  
  3625. function TIndexDefs.IndexOf(const Name: string): Integer;
  3626. begin
  3627.   for Result := 0 to FItems.Count - 1 do
  3628.     if AnsiCompareText(TIndexDef(FItems[Result]).FName, Name) = 0 then Exit;
  3629.   Result := -1;
  3630. end;
  3631.  
  3632. procedure TIndexDefs.Update;
  3633. begin
  3634.   FDataSet.UpdateIndexDefs;
  3635. end;
  3636.  
  3637. { TDataLink }
  3638.  
  3639. constructor TDataLink.Create;
  3640. begin
  3641.   inherited Create;
  3642.   FBufferCount := 1;
  3643. end;
  3644.  
  3645. destructor TDataLink.Destroy;
  3646. begin
  3647.   FActive := False;
  3648.   FEditing := False;
  3649.   FDataSourceFixed := False;
  3650.   SetDataSource(nil);
  3651.   inherited Destroy;
  3652. end;
  3653.  
  3654. procedure TDataLink.UpdateRange;
  3655. var
  3656.   Min, Max: Integer;
  3657. begin
  3658.   Min := DataSet.FActiveRecord - FBufferCount + 1;
  3659.   if Min < 0 then Min := 0;
  3660.   Max := DataSet.FBufferCount - FBufferCount;
  3661.   if Max < 0 then Max := 0;
  3662.   if Max > DataSet.FActiveRecord then Max := DataSet.FActiveRecord;
  3663.   if FFirstRecord < Min then FFirstRecord := Min;
  3664.   if FFirstRecord > Max then FFirstRecord := Max;
  3665. end;
  3666.  
  3667. function TDataLink.GetDataSet: TDataSet;
  3668. begin
  3669.   if DataSource <> nil then Result := DataSource.DataSet else Result := nil;
  3670. end;
  3671.  
  3672. procedure TDataLink.SetDataSource(ADataSource: TDataSource);
  3673. begin
  3674.   if FDataSource <> ADataSource then
  3675.   begin
  3676.     if FDataSourceFixed then DatabaseError(SDataSourceChange);
  3677.     if FDataSource <> nil then FDataSource.RemoveDataLink(Self);
  3678.     if ADataSource <> nil then ADataSource.AddDataLink(Self);
  3679.   end;
  3680. end;
  3681.  
  3682. procedure TDataLink.SetReadOnly(Value: Boolean);
  3683. begin
  3684.   if FReadOnly <> Value then
  3685.   begin
  3686.     FReadOnly := Value;
  3687.     UpdateState;
  3688.   end;
  3689. end;
  3690.  
  3691. procedure TDataLink.SetActive(Value: Boolean);
  3692. begin
  3693.   if FActive <> Value then
  3694.   begin
  3695.     FActive := Value;
  3696.     if Value then UpdateRange else FFirstRecord := 0;
  3697.     ActiveChanged;
  3698.   end;
  3699. end;
  3700.  
  3701. procedure TDataLink.SetEditing(Value: Boolean);
  3702. begin
  3703.   if FEditing <> Value then
  3704.   begin
  3705.     FEditing := Value;
  3706.     EditingChanged;
  3707.   end;
  3708. end;
  3709.  
  3710. procedure TDataLink.UpdateState;
  3711. begin
  3712.   SetActive((DataSource <> nil) and (DataSource.State <> dsInactive));
  3713.   SetEditing((DataSource <> nil) and (DataSource.State in dsEditModes) and
  3714.     not FReadOnly);
  3715. end;
  3716.  
  3717. procedure TDataLink.UpdateRecord;
  3718. begin
  3719.   FUpdating := True;
  3720.   try
  3721.     UpdateData;
  3722.   finally
  3723.     FUpdating := False;
  3724.   end;
  3725. end;
  3726.  
  3727. function TDataLink.Edit: Boolean;
  3728. begin
  3729.   if not FReadOnly and (DataSource <> nil) then DataSource.Edit;
  3730.   Result := FEditing;
  3731. end;
  3732.  
  3733. function TDataLink.GetActiveRecord: Integer;
  3734. begin
  3735.   if DataSource.State = dsSetKey then
  3736.     Result := 0 else
  3737.     Result := DataSource.DataSet.FActiveRecord - FFirstRecord;
  3738. end;
  3739.  
  3740. procedure TDataLink.SetActiveRecord(Value: Integer);
  3741. begin
  3742.   if DataSource.State <> dsSetKey then
  3743.     DataSource.DataSet.FActiveRecord := Value + FFirstRecord;
  3744. end;
  3745.  
  3746. procedure TDataLink.SetBufferCount(Value: Integer);
  3747. begin
  3748.   if FBufferCount <> Value then
  3749.   begin
  3750.     FBufferCount := Value;
  3751.     if Active then
  3752.     begin
  3753.       UpdateRange;
  3754.       DataSet.UpdateBufferCount;
  3755.       UpdateRange;
  3756.     end;
  3757.   end;
  3758. end;
  3759.  
  3760. function TDataLink.GetRecordCount: Integer;
  3761. begin
  3762.   if DataSource.State = dsSetKey then Result := 1 else
  3763.   begin
  3764.     Result := DataSource.DataSet.FRecordCount;
  3765.     if Result > FBufferCount then Result := FBufferCount;
  3766.   end;
  3767. end;
  3768.  
  3769. procedure TDataLink.DataEvent(Event: TDataEvent; Info: Longint);
  3770. var
  3771.   Active, First, Last, Count: Integer;
  3772. begin
  3773.   if Event = deUpdateState then UpdateState else
  3774.     if FActive then
  3775.       case Event of
  3776.         deFieldChange, deRecordChange:
  3777.           if not FUpdating then RecordChanged(TField(Info));
  3778.         deDataSetChange, deDataSetScroll, deLayoutChange:
  3779.           begin
  3780.             Count := 0;
  3781.             if DataSource.State <> dsSetKey then
  3782.             begin
  3783.               Active := DataSource.DataSet.FActiveRecord;
  3784.               First := FFirstRecord + Info;
  3785.               Last := First + FBufferCount - 1;
  3786.               if Active > Last then Count := Active - Last else
  3787.                 if Active < First then Count := Active - First;
  3788.               FFirstRecord := First + Count;
  3789.             end;
  3790.             case Event of
  3791.               deDataSetChange: DataSetChanged;
  3792.               deDataSetScroll: DataSetScrolled(Count);
  3793.               deLayoutChange: LayoutChanged;
  3794.             end;
  3795.           end;
  3796.         deUpdateRecord:
  3797.           UpdateRecord;
  3798.         deCheckBrowseMode:
  3799.           CheckBrowseMode;
  3800.         deFocusControl:
  3801.           FocusControl(TFieldRef(Info));
  3802.       end;
  3803. end;
  3804.  
  3805. procedure TDataLink.ActiveChanged;
  3806. begin
  3807. end;
  3808.  
  3809. procedure TDataLink.CheckBrowseMode;
  3810. begin
  3811. end;
  3812.  
  3813. procedure TDataLink.DataSetChanged;
  3814. begin
  3815.   RecordChanged(nil);
  3816. end;
  3817.  
  3818. procedure TDataLink.DataSetScrolled(Distance: Integer);
  3819. begin
  3820.   DataSetChanged;
  3821. end;
  3822.  
  3823. procedure TDataLink.EditingChanged;
  3824. begin
  3825. end;
  3826.  
  3827. procedure TDataLink.FocusControl(Field: TFieldRef);
  3828. begin
  3829. end;
  3830.  
  3831. procedure TDataLink.LayoutChanged;
  3832. begin
  3833.   DataSetChanged;
  3834. end;
  3835.  
  3836. procedure TDataLink.RecordChanged(Field: TField);
  3837. begin
  3838. end;
  3839.  
  3840. procedure TDataLink.UpdateData;
  3841. begin
  3842. end;
  3843.  
  3844. { TDataSource }
  3845.  
  3846. constructor TDataSource.Create(AOwner: TComponent);
  3847. begin
  3848.   inherited Create(AOwner);
  3849.   FDataLinks := TList.Create;
  3850.   FEnabled := True;
  3851.   FAutoEdit := True;
  3852. end;
  3853.  
  3854. destructor TDataSource.Destroy;
  3855. begin
  3856.   FOnStateChange := nil;
  3857.   SetDataSet(nil);
  3858.   while FDataLinks.Count > 0 do RemoveDataLink(FDataLinks.Last);
  3859.   FDataLinks.Free;
  3860.   inherited Destroy;
  3861. end;
  3862.  
  3863. procedure TDataSource.Edit;
  3864. begin
  3865.   if AutoEdit and (State = dsBrowse) then DataSet.Edit;
  3866. end;
  3867.  
  3868. procedure TDataSource.SetState(Value: TDataSetState);
  3869. var
  3870.   PriorState: TDataSetState;
  3871. begin
  3872.   if FState <> Value then
  3873.   begin
  3874.     PriorState := FState;
  3875.     FState := Value;
  3876.     NotifyDataLinks(deUpdateState, 0);
  3877.     if not (csDestroying in ComponentState) then
  3878.     begin
  3879.       if Assigned(FOnStateChange) then FOnStateChange(Self);
  3880.       if PriorState = dsInactive then
  3881.         if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  3882.     end;
  3883.   end;
  3884. end;
  3885.  
  3886. procedure TDataSource.UpdateState;
  3887. begin
  3888.   if Enabled and (DataSet <> nil) then
  3889.     SetState(DataSet.State) else
  3890.     SetState(dsInactive);
  3891. end;
  3892.  
  3893. function TDataSource.IsLinkedTo(DataSet: TDataSet): Boolean;
  3894. var
  3895.   DataSource: TDataSource;
  3896. begin
  3897.   Result := True;
  3898.   while DataSet <> nil do
  3899.   begin
  3900.     DataSource := DataSet.GetDataSource;
  3901.     if DataSource = nil then Break;
  3902.     if DataSource = Self then Exit;
  3903.     DataSet := DataSource.DataSet;
  3904.   end;
  3905.   Result := False;
  3906. end;
  3907.  
  3908. procedure TDataSource.SetDataSet(ADataSet: TDataSet);
  3909. begin
  3910.   if IsLinkedTo(ADataSet) then DatabaseError(SCircularDataLink);
  3911.   if FDataSet <> nil then FDataSet.RemoveDataSource(Self);
  3912.   if ADataSet <> nil then ADataSet.AddDataSource(Self);
  3913. end;
  3914.  
  3915. procedure TDataSource.SetEnabled(Value: Boolean);
  3916. begin
  3917.   FEnabled := Value;
  3918.   UpdateState;
  3919. end;
  3920.  
  3921. procedure TDataSource.AddDataLink(DataLink: TDataLink);
  3922. begin
  3923.   FDataLinks.Add(DataLink);
  3924.   DataLink.FDataSource := Self;
  3925.   if DataSet <> nil then DataSet.UpdateBufferCount;
  3926.   DataLink.UpdateState;
  3927. end;
  3928.  
  3929. procedure TDataSource.RemoveDataLink(DataLink: TDataLink);
  3930. begin
  3931.   DataLink.FDataSource := nil;
  3932.   FDataLinks.Remove(DataLink);
  3933.   DataLink.UpdateState;
  3934.   if DataSet <> nil then DataSet.UpdateBufferCount;
  3935. end;
  3936.  
  3937. procedure TDataSource.NotifyDataLinks(Event: TDataEvent; Info: Longint);
  3938. var
  3939.   I: Integer;
  3940. begin
  3941.   for I := 0 to FDataLinks.Count - 1 do
  3942.     with TDataLink(FDataLinks[I]) do
  3943.       if FBufferCount = 1 then DataEvent(Event, Info);
  3944.   for I := 0 to FDataLinks.Count - 1 do
  3945.     with TDataLink(FDataLinks[I]) do
  3946.       if FBufferCount > 1 then DataEvent(Event, Info);
  3947. end;
  3948.  
  3949. procedure TDataSource.DataEvent(Event: TDataEvent; Info: Longint);
  3950. begin
  3951.   if Event = deUpdateState then UpdateState else
  3952.     if FState <> dsInactive then
  3953.     begin
  3954.       NotifyDataLinks(Event, Info);
  3955.       case Event of
  3956.         deFieldChange:
  3957.           if Assigned(FOnDataChange) then FOnDataChange(Self, TField(Info));
  3958.         deRecordChange, deDataSetChange, deDataSetScroll, deLayoutChange:
  3959.           if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  3960.         deUpdateRecord:
  3961.           if Assigned(FOnUpdateData) then FOnUpdateData(Self);
  3962.       end;
  3963.     end;
  3964. end;
  3965.  
  3966. { TCheckConstraint }
  3967.  
  3968. procedure TCheckConstraint.Assign(Source: TPersistent);
  3969. begin
  3970.   if Source is TCheckConstraint then
  3971.   begin
  3972.     ImportedConstraint := TCheckConstraint(Source).ImportedConstraint;
  3973.     CustomConstraint := TCheckConstraint(Source).CustomConstraint;
  3974.     ErrorMessage := TCheckConstraint(Source).ErrorMessage;
  3975.   end
  3976.   else inherited Assign(Source);
  3977. end;
  3978.  
  3979. function TCheckConstraint.GetDisplayName: string;
  3980. begin
  3981.   Result := ImportedConstraint;
  3982.   if Result = '' then Result := CustomConstraint;
  3983.   if Result = '' then Result := inherited GetDisplayName;
  3984. end;
  3985.  
  3986. procedure TCheckConstraint.SetImportedConstraint(const Value: string);
  3987. begin
  3988.   if ImportedConstraint <> Value then
  3989.   begin
  3990.     FImportedConstraint := Value;
  3991.     Changed(True);
  3992.   end;
  3993. end;
  3994.  
  3995. procedure TCheckConstraint.SetCustomConstraint(const Value: string);
  3996. begin
  3997.   if CustomConstraint <> Value then
  3998.   begin
  3999.     FCustomConstraint := Value;
  4000.     Changed(True);
  4001.   end;
  4002. end;
  4003.  
  4004. procedure TCheckConstraint.SetErrorMessage(const Value: string);
  4005. begin
  4006.   if ErrorMessage <> Value then
  4007.   begin
  4008.     FErrorMessage := Value;
  4009.     Changed(True);
  4010.   end;
  4011. end;
  4012.  
  4013. { TCheckConstraints }
  4014.  
  4015. constructor TCheckConstraints.Create(Owner: TPersistent);
  4016. begin
  4017.   inherited Create(TCheckConstraint);
  4018.   FOwner := Owner;
  4019. end;
  4020.  
  4021. function TCheckConstraints.Add: TCheckConstraint;
  4022. begin
  4023.   Result := TCheckConstraint(inherited Add);
  4024. end;
  4025.  
  4026. function TCheckConstraints.GetOwner: TPersistent;
  4027. begin
  4028.   Result := FOwner;
  4029. end;
  4030.  
  4031. function TCheckConstraints.GetItem(Index: Integer): TCheckConstraint;
  4032. begin
  4033.   Result := TCheckConstraint(inherited GetItem(Index));
  4034. end;
  4035.  
  4036. procedure TCheckConstraints.SetItem(Index: Integer; Value: TCheckConstraint);
  4037. begin
  4038.   inherited SetItem(Index, Value);
  4039. end;
  4040.  
  4041. { TDataSet }
  4042.  
  4043. constructor TDataSet.Create(AOwner: TComponent);
  4044. begin
  4045.   inherited Create(AOwner);
  4046.   FFieldDefs := TFieldDefs.Create(Self);
  4047.   FFields := TList.Create;
  4048.   FDataSources := TList.Create;
  4049.   FAutoCalcFields := True;
  4050.   FConstraints := TCheckConstraints.Create(Self);
  4051.   ClearBuffers;
  4052. end;
  4053.  
  4054. destructor TDataSet.Destroy;
  4055. begin
  4056.   Destroying;
  4057.   Close;
  4058.   FDesigner.Free;
  4059.   if Assigned(FDataSources) then
  4060.     while FDataSources.Count > 0 do
  4061.       RemoveDataSource(FDataSources.Last);
  4062.   FDataSources.Free;
  4063.   if Assigned(FFields) then
  4064.     DestroyFields;
  4065.   FFields.Free;
  4066.   FFieldDefs.Free;
  4067.   FConstraints.Free;
  4068.   inherited Destroy;
  4069. end;
  4070.  
  4071. procedure TDataSet.SetName(const Value: TComponentName);
  4072. var
  4073.   I: Integer;
  4074.   OldName, FieldName, NamePrefix: TComponentName;
  4075.   Field: TField;
  4076. begin
  4077.   OldName := Name;
  4078.   inherited SetName(Value);
  4079.   if (csDesigning in ComponentState) and (Name <> OldName) then
  4080.     { In design mode the name of the fields should track the data set name }
  4081.     for I := 0 to FFields.Count - 1 do
  4082.     begin
  4083.       Field := FFields[I];
  4084.       if Field.Owner = Owner then
  4085.       begin
  4086.         FieldName := Field.Name;
  4087.         NamePrefix := FieldName;
  4088.         if Length(NamePrefix) > Length(OldName) then
  4089.         begin
  4090.           SetLength(NamePrefix, Length(OldName));
  4091.           if CompareText(OldName, NamePrefix) = 0 then
  4092.           begin
  4093.             System.Delete(FieldName, 1, Length(OldName));
  4094.             System.Insert(Value, FieldName, 1);
  4095.             try
  4096.               Field.Name := FieldName;
  4097.             except
  4098.               on EComponentError do {Ignore rename errors };
  4099.             end;
  4100.           end;
  4101.         end;
  4102.       end;
  4103.     end;
  4104. end;
  4105.  
  4106. procedure TDataSet.GetChildren(Proc: TGetChildProc; Root: TComponent);
  4107. var
  4108.   I: Integer;
  4109.   Field: TField;
  4110. begin
  4111.   for I := 0 to FFields.Count - 1 do
  4112.   begin
  4113.     Field := FFields[I];
  4114.     if Field.Owner = Root then Proc(Field);
  4115.   end;
  4116. end;
  4117.  
  4118. procedure TDataSet.SetChildOrder(Component: TComponent; Order: Integer);
  4119. begin
  4120.   if FFields.IndexOf(Component) >= 0 then
  4121.     (Component as TField).Index := Order;
  4122. end;
  4123.  
  4124. procedure TDataSet.Loaded;
  4125. begin
  4126.   inherited Loaded;
  4127.   try
  4128.     if FStreamedActive then Active := True;
  4129.   except
  4130.     if csDesigning in ComponentState then
  4131.       InternalHandleException else
  4132.       raise;
  4133.   end;
  4134. end;
  4135.  
  4136. procedure TDataSet.SetState(Value: TDataSetState);
  4137. begin
  4138.   if FState <> Value then
  4139.   begin
  4140.     FState := Value;
  4141.     FModified := False;
  4142.     DataEvent(deUpdateState, 0);
  4143.   end;
  4144. end;
  4145.  
  4146. procedure TDataSet.SetModified(Value: Boolean);
  4147. begin
  4148.   FModified := Value;
  4149. end;
  4150.  
  4151. function TDataSet.GetFound: Boolean;
  4152. begin
  4153.   Result := FFound;
  4154. end;
  4155.  
  4156. procedure TDataSet.SetFound(const Value: Boolean);
  4157. begin
  4158.   FFound := Value;
  4159. end;
  4160.  
  4161. function TDataSet.SetTempState(const Value: TDataSetState): TDataSetState;
  4162. begin
  4163.   Result := FState;
  4164.   FState := Value;
  4165.   Inc(FDisableCount);
  4166.   FModified := False;
  4167. end;
  4168.  
  4169. procedure TDataSet.RestoreState(const Value: TDataSetState);
  4170. begin
  4171.   FState := Value;
  4172.   Dec(FDisableCount);
  4173.   FModified := False;
  4174. end;
  4175.  
  4176. procedure TDataSet.Open;
  4177. begin
  4178.   Active := True;
  4179. end;
  4180.  
  4181. procedure TDataSet.Close;
  4182. begin
  4183.   Active := False;
  4184. end;
  4185.  
  4186. procedure TDataSet.CheckInactive;
  4187. begin
  4188.   if Active then
  4189.     if csUpdating in ComponentState then
  4190.       Close else
  4191.       DatabaseError(SDataSetOpen);
  4192. end;
  4193.  
  4194. procedure TDataSet.CheckActive;
  4195. begin
  4196.   if State = dsInactive then DatabaseError(SDataSetClosed);
  4197. end;
  4198.  
  4199. function TDataSet.GetActive: Boolean;
  4200. begin
  4201.   Result := State <> dsInactive;
  4202. end;
  4203.  
  4204. procedure TDataSet.SetActive(Value: Boolean);
  4205. begin
  4206.   if (csReading in ComponentState) then
  4207.   begin
  4208.     if Value then FStreamedActive := True;
  4209.   end
  4210.   else
  4211.     if Active <> Value then
  4212.     begin
  4213.       if Value then
  4214.       begin
  4215.         DoBeforeOpen;
  4216.         try
  4217.           OpenCursor(False);
  4218.           SetState(dsBrowse);
  4219.         except
  4220.           SetState(dsInactive);
  4221.           CloseCursor;
  4222.           raise;
  4223.         end;
  4224.         DoAfterOpen;
  4225.       end else
  4226.       begin
  4227.         if not (csDestroying in ComponentState) then DoBeforeClose;
  4228.         SetState(dsInactive);
  4229.         CloseCursor;
  4230.         if not (csDestroying in ComponentState) then DoAfterClose;
  4231.       end;
  4232.     end;
  4233. end;
  4234.  
  4235. procedure TDataSet.DoInternalOpen;
  4236. begin
  4237.   FDefaultFields := FieldCount = 0;
  4238.   InternalOpen;
  4239.   UpdateBufferCount;
  4240.   FBOF := True;
  4241. end;
  4242.  
  4243. procedure TDataSet.DoInternalClose;
  4244. begin
  4245.   FreeFieldBuffers;
  4246.   ClearBuffers;
  4247.   SetBufListSize(0);
  4248.   InternalClose;
  4249.   FBufferCount := 0;
  4250.   FDefaultFields := False;
  4251. end;
  4252.  
  4253. procedure TDataSet.OpenCursor(InfoQuery: Boolean);
  4254. begin
  4255.   if InfoQuery then
  4256.     InternalInitFieldDefs else
  4257.     DoInternalOpen;
  4258. end;
  4259.  
  4260. procedure TDataSet.CloseCursor;
  4261. begin
  4262.   DoInternalClose;
  4263. end;
  4264.  
  4265. procedure TDataSet.InitFieldDefs;
  4266. begin
  4267.   if not Active then
  4268.     try
  4269.       OpenCursor(True);
  4270.     finally
  4271.       CloseCursor;
  4272.     end;
  4273. end;
  4274.  
  4275. { Field Management }
  4276.  
  4277. function TDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  4278. begin
  4279.   Result := DefaultFieldClasses[FieldType];
  4280. end;
  4281.  
  4282. procedure TDataSet.CreateFields;
  4283. var
  4284.   I: Integer;
  4285. begin
  4286.   for I := 0 to FFieldDefs.Count - 1 do
  4287.     with FFieldDefs[I] do
  4288.       if DataType <> ftUnknown then CreateField(Self);
  4289. end;
  4290.  
  4291. procedure TDataSet.DestroyFields;
  4292. var
  4293.   Field: TField;
  4294. begin
  4295.   while FFields.Count > 0 do
  4296.   begin
  4297.     Field := FFields.Last;
  4298.     RemoveField(Field);
  4299.     Field.Free;
  4300.   end;
  4301. end;
  4302.  
  4303. procedure TDataSet.BindFields(Binding: Boolean);
  4304. const
  4305.   CalcFieldTypes = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean,
  4306.     ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime];
  4307.   BaseTypes: array[TFieldType] of TFieldType = (
  4308.     ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  4309.     ftBoolean, ftFloat, ftFloat, ftBCD, ftDate, ftTime, ftDateTime,
  4310.     ftBytes, ftVarBytes, ftInteger, ftBlob, ftBlob, ftBlob,
  4311.     ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown);
  4312. var
  4313.   I: Integer;
  4314.   FieldDef: TFieldDef;
  4315. begin
  4316.   FCalcFieldsSize := 0;
  4317.   FBlobFieldCount := 0;
  4318.   FInternalCalcFields := False;
  4319.   for I := 0 to FFields.Count - 1 do
  4320.     with TField(FFields[I]) do
  4321.       if Binding then
  4322.       begin
  4323.         if FieldKind in [fkCalculated, fkLookup] then
  4324.         begin
  4325.           if not (DataType in CalcFieldTypes) then
  4326.             DatabaseErrorFmt(SInvalidCalcType, [DisplayName]);
  4327.           FFieldNo := -1;
  4328.           FOffset := FCalcFieldsSize;
  4329.           Inc(FCalcFieldsSize, DataSize + 1);
  4330.         end else
  4331.         begin
  4332.           FieldDef := FieldDefs.Find(FFieldName);
  4333.           if (BaseTypes[DataType] <> BaseTypes[FieldDef.DataType]) or
  4334.             (Size <> FieldDef.Size) then
  4335.             DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName]);
  4336.           FFieldNo := FieldDef.FieldNo;
  4337.           if FieldDef.InternalCalcField then
  4338.             FInternalCalcFields := True;
  4339.           if BaseTypes[FieldDef.DataType] = ftBlob then
  4340.           begin
  4341.             FOffset := FBlobFieldCount;
  4342.             Inc(FBlobFieldCount);
  4343.           end;
  4344.         end;
  4345.         Bind(True);
  4346.       end else
  4347.       begin
  4348.         Bind(False);
  4349.         FFieldNo := 0;
  4350.       end;
  4351. end;
  4352.  
  4353. procedure TDataSet.AddField(Field: TField);
  4354. begin
  4355.   FFields.Add(Field);
  4356.   Field.FDataSet := Self;
  4357.   DataEvent(deFieldListChange, 0)
  4358. end;
  4359.  
  4360. procedure TDataSet.RemoveField(Field: TField);
  4361. begin
  4362.   Field.FDataSet := nil;
  4363.   FFields.Remove(Field);
  4364.   if not (csDestroying in ComponentState) then
  4365.     DataEvent(deFieldListChange, 0)
  4366. end;
  4367.  
  4368. procedure TDataSet.FreeFieldBuffers;
  4369. var
  4370.   I: Integer;
  4371. begin
  4372.   for I := 0 to FFields.Count - 1 do TField(FFields[I]).FreeBuffers;
  4373. end;
  4374.  
  4375. procedure TDataSet.SetFieldDefs(Value: TFieldDefs);
  4376. begin
  4377.   FFieldDefs.Assign(Value);
  4378. end;
  4379.  
  4380. procedure TDataSet.UpdateFieldDefs;
  4381. begin
  4382.   if not FFieldDefs.FUpdated then
  4383.   begin
  4384.     InitFieldDefs;
  4385.     FFieldDefs.FUpdated := True;
  4386.   end;
  4387. end;
  4388.  
  4389. function TDataSet.GetFieldCount: Integer;
  4390. begin
  4391.   Result := FFields.Count;
  4392. end;
  4393.  
  4394. function TDataSet.GetField(Index: Integer): TField;
  4395. begin
  4396.   Result := FFields[Index];
  4397. end;
  4398.  
  4399. procedure TDataSet.SetField(Index: Integer; Value: TField);
  4400. begin
  4401.   TField(FFields[Index]).Assign(Value);
  4402. end;
  4403.  
  4404. function TDataSet.GetFieldValue(const FieldName: string): Variant;
  4405. var
  4406.   I: Integer;
  4407.   Fields: TList;
  4408. begin
  4409.   if Pos(';', FieldName) <> 0 then
  4410.   begin
  4411.     Fields := TList.Create;
  4412.     try
  4413.       GetFieldList(Fields, FieldName);
  4414.       Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
  4415.       for I := 0 to Fields.Count - 1 do
  4416.         Result[I] := TField(Fields[I]).Value;
  4417.     finally
  4418.       Fields.Free;
  4419.     end;
  4420.   end else
  4421.     Result := FieldByName(FieldName).Value
  4422. end;
  4423.  
  4424. procedure TDataSet.SetFieldValue(const FieldName: string;
  4425.   const Value: Variant);
  4426. var
  4427.   I: Integer;
  4428.   Fields: TList;
  4429. begin
  4430.   if Pos(';', FieldName) <> 0 then
  4431.   begin
  4432.     Fields := TList.Create;
  4433.     try
  4434.       GetFieldList(Fields, FieldName);
  4435.       for I := 0 to Fields.Count - 1 do
  4436.         TField(Fields[I]).Value := Value[I];
  4437.     finally
  4438.       Fields.Free;
  4439.     end;
  4440.   end else
  4441.     FieldByName(FieldName).Value := Value;
  4442. end;
  4443.  
  4444. function TDataSet.FieldByName(const FieldName: string): TField;
  4445. begin
  4446.   Result := FindField(FieldName);
  4447.   if Result = nil then DatabaseErrorFmt(SFieldNotFound, [Name, FieldName]);
  4448. end;
  4449.  
  4450. function TDataSet.FieldByNumber(FieldNo: Integer): TField;
  4451. var
  4452.   I: Integer;
  4453. begin
  4454.   for I := 0 to FFields.Count - 1 do
  4455.   begin
  4456.     Result := Fields[I];
  4457.     if Result.FieldNo = FieldNo then Exit;
  4458.   end;
  4459.   Result := nil;
  4460. end;
  4461.  
  4462. function TDataSet.FindField(const FieldName: string): TField;
  4463. var
  4464.   I: Integer;
  4465. begin
  4466.   for I := 0 to FFields.Count - 1 do
  4467.   begin
  4468.     Result := FFields[I];
  4469.     if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  4470.   end;
  4471.   Result := nil;
  4472. end;
  4473.  
  4474. procedure TDataSet.SetConstraints(const Value: TCheckConstraints);
  4475. begin
  4476.   FConstraints.Assign(Value);
  4477. end;
  4478.  
  4479. procedure TDataSet.CheckFieldName(const FieldName: string);
  4480. begin
  4481.   if FieldName = '' then DatabaseError(SFieldNameMissing);
  4482.   if FindField(FieldName) <> nil then
  4483.     DatabaseErrorFmt(SDuplicateFieldName, [FieldName]);
  4484. end;
  4485.  
  4486. procedure TDataSet.CheckFieldNames(const FieldNames: string);
  4487. var
  4488.   Pos: Integer;
  4489. begin
  4490.   Pos := 1;
  4491.   while Pos <= Length(FieldNames) do
  4492.     FieldByName(ExtractFieldName(FieldNames, Pos));
  4493. end;
  4494.  
  4495. procedure TDataSet.GetFieldNames(List: TStrings);
  4496. var
  4497.   I: Integer;
  4498. begin
  4499.   List.BeginUpdate;
  4500.   try
  4501.     List.Clear;
  4502.     if FFields.Count > 0 then
  4503.       for I := 0 to FFields.Count - 1 do
  4504.         List.Add(TField(FFields[I]).FFieldName)
  4505.     else
  4506.     begin
  4507.       UpdateFieldDefs;
  4508.       for I := 0 to FFieldDefs.Count - 1 do
  4509.         List.Add(FFieldDefs[I].Name);
  4510.     end;
  4511.   finally
  4512.     List.EndUpdate;
  4513.   end;
  4514. end;
  4515.  
  4516. function TDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
  4517. var
  4518.   SaveState: TDataSetState;
  4519. begin
  4520.   if Field.FieldKind in [fkData, fkInternalCalc] then
  4521.   begin
  4522.     SaveState := SetTempState(State);
  4523.     try
  4524.       Result := Field.AsVariant;
  4525.     finally
  4526.       RestoreState(SaveState);
  4527.     end;
  4528.   end else
  4529.     Result := NULL;
  4530. end;
  4531.  
  4532. procedure TDataSet.SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant);
  4533. var
  4534.   SaveState: TDataSetState;
  4535. begin
  4536.   if Field.FieldKind <> fkData then Exit;
  4537.   SaveState := SetTempState(State);
  4538.   try
  4539.     Field.AsVariant := Value;
  4540.   finally
  4541.     RestoreState(SaveState);
  4542.   end;
  4543. end;
  4544.  
  4545. procedure TDataSet.CloseBlob(Field: TField);
  4546. begin
  4547. end;
  4548.  
  4549. function TDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  4550. begin
  4551.   Result := nil;
  4552. end;
  4553.  
  4554. function TDataSet.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
  4555. begin
  4556.   Result := False;
  4557. end;
  4558.  
  4559. function TDataSet.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  4560.   Decimals: Integer): Boolean;
  4561. begin
  4562.   Result := False;
  4563. end;
  4564.  
  4565. { Index Related }
  4566.  
  4567. function TDataSet.GetIsIndexField(Field: TField): Boolean;
  4568. begin
  4569.   Result := False;
  4570. end;
  4571.  
  4572. procedure TDataSet.UpdateIndexDefs;
  4573. begin
  4574. end;
  4575.  
  4576. { Datasource/Datalink Interaction }
  4577.  
  4578. function TDataSet.GetDataSource: TDataSource;
  4579. begin
  4580.   Result := nil;
  4581. end;
  4582.  
  4583. function TDataSet.IsLinkedTo(DataSource: TDataSource): Boolean;
  4584. var
  4585.   DataSet: TDataSet;
  4586. begin
  4587.   Result := True;
  4588.   while DataSource <> nil do
  4589.   begin
  4590.     DataSet := DataSource.DataSet;
  4591.     if DataSet = nil then Break;
  4592.     if DataSet = Self then Exit;
  4593.     DataSource := DataSet.DataSource;
  4594.   end;
  4595.   Result := False;
  4596. end;
  4597.  
  4598. procedure TDataSet.AddDataSource(DataSource: TDataSource);
  4599. begin
  4600.   FDataSources.Add(DataSource);
  4601.   DataSource.FDataSet := Self;
  4602.   UpdateBufferCount;
  4603.   DataSource.UpdateState;
  4604. end;
  4605.  
  4606. procedure TDataSet.RemoveDataSource(DataSource: TDataSource);
  4607. begin
  4608.   DataSource.FDataSet := nil;
  4609.   FDataSources.Remove(DataSource);
  4610.   DataSource.UpdateState;
  4611.   UpdateBufferCount;
  4612. end;
  4613.  
  4614. procedure TDataSet.DataEvent(Event: TDataEvent; Info: Longint);
  4615. var
  4616.   I: Integer;
  4617. begin
  4618.   case Event of
  4619.     deFieldChange:
  4620.       begin
  4621.         if TField(Info).FieldKind in [fkData, fkInternalCalc] then
  4622.           FModified := True;
  4623.         if State <> dsSetKey then
  4624.         begin
  4625.           if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
  4626.             RefreshInternalCalcFields(ActiveBuffer)
  4627.           else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
  4628.             (TField(Info).FieldKind = fkData) then
  4629.             CalculateFields(ActiveBuffer);
  4630.           TField(Info).Change;
  4631.         end;
  4632.       end;
  4633.     dePropertyChange:
  4634.       FFieldDefs.FUpdated := False;
  4635.   end;
  4636.   if FDisableCount = 0 then
  4637.   begin
  4638.     for I := 0 to FDataSources.Count - 1 do
  4639.       TDataSource(FDataSources[I]).DataEvent(Event, Info);
  4640.     if FDesigner <> nil then FDesigner.DataEvent(Event, Info);
  4641.   end else
  4642.     if (Event = deUpdateState) and (State = dsInactive) or
  4643.       (Event = deLayoutChange) then FEnableEvent := deLayoutChange;
  4644. end;
  4645.  
  4646. function TDataset.ControlsDisabled: Boolean;
  4647. begin
  4648.   Result := FDisableCount <> 0;
  4649. end;
  4650.  
  4651. procedure TDataSet.DisableControls;
  4652. begin
  4653.   if FDisableCount = 0 then
  4654.   begin
  4655.     FDisableState := FState;
  4656.     FEnableEvent := deDataSetChange;
  4657.   end;
  4658.   Inc(FDisableCount);
  4659. end;
  4660.  
  4661. procedure TDataSet.EnableControls;
  4662. begin
  4663.   if FDisableCount <> 0 then
  4664.   begin
  4665.     Dec(FDisableCount);
  4666.     if FDisableCount = 0 then
  4667.     begin
  4668.       if FDisableState <> FState then DataEvent(deUpdateState, 0);
  4669.       if (FDisableState <> dsInactive) and (FState <> dsInactive) then
  4670.         DataEvent(FEnableEvent, 0);
  4671.     end;
  4672.   end;
  4673. end;
  4674.  
  4675. procedure TDataSet.UpdateRecord;
  4676. begin
  4677.   if not (State in dsEditModes) then DatabaseError(SNotEditing);
  4678.   DataEvent(deUpdateRecord, 0);
  4679. end;
  4680.  
  4681. { Buffer Management }
  4682.  
  4683. procedure TDataSet.SetBufListSize(Value: Integer);
  4684. var
  4685.   I: Integer;
  4686.   NewList: PBufferList;
  4687. begin
  4688.   if FBufListSize <> Value then
  4689.   begin
  4690.     GetMem(NewList, Value * SizeOf(Pointer));
  4691.     if FBufListSize > Value then
  4692.     begin
  4693.       if Value <> 0 then
  4694.         Move(FBuffers^, NewList^, Value * SizeOf(Pointer));
  4695.       for I := Value to FBufListSize - 1 do
  4696.         FreeRecordBuffer(FBuffers^[I]);
  4697.     end else
  4698.     begin
  4699.       if FBufListSize <> 0 then
  4700.         Move(FBuffers^, NewList^, FBufListSize * SizeOf(Pointer));
  4701.       I := FBufListSize;
  4702.       try
  4703.         while I < Value do
  4704.         begin
  4705.           NewList^[I] := AllocRecordBuffer;
  4706.           Inc(I);
  4707.         end;
  4708.       except
  4709.         while I > FBufListSize do
  4710.         begin
  4711.           FreeRecordBuffer(NewList^[I]);
  4712.           Dec(I);
  4713.         end;
  4714.         FreeMem(NewList, Value * SizeOf(Pointer));
  4715.         raise;
  4716.       end;
  4717.     end;
  4718.     FreeMem(FBuffers, FBufListSize * SizeOf(Pointer));
  4719.     FBuffers := NewList;
  4720.     FBufListSize := Value;
  4721.   end;
  4722. end;
  4723.  
  4724. procedure TDataSet.SetBufferCount(Value: Integer);
  4725. var
  4726.   I, Delta: Integer;
  4727.   DataLink: TDataLink;
  4728.  
  4729.   procedure AdjustFirstRecord(Delta: Integer);
  4730.   var
  4731.     DataLink: TDataLink;
  4732.   begin
  4733.     if Delta <> 0 then
  4734.     begin
  4735.       DataLink := FFirstDataLink;
  4736.       while DataLink <> nil do
  4737.       begin
  4738.         if DataLink.Active then Inc(DataLink.FFirstRecord, Delta);
  4739.         DataLink := DataLink.FNext;
  4740.       end;
  4741.     end;
  4742.   end;
  4743.  
  4744. begin
  4745.   if FBufferCount <> Value then
  4746.   begin
  4747.     if (FBufferCount > Value) and (FRecordCount > 0) then
  4748.     begin
  4749.       Delta := FActiveRecord;
  4750.       DataLink := FFirstDataLink;
  4751.       while DataLink <> nil do
  4752.       begin
  4753.         if DataLink.Active and (DataLink.FFirstRecord < Delta) then
  4754.           Delta := DataLink.FFirstRecord;
  4755.         DataLink := DataLink.FNext;
  4756.       end;
  4757.       for I := 0 to Value - 1 do MoveBuffer(I + Delta, I);
  4758.       Dec(FActiveRecord, Delta);
  4759.       if FCurrentRecord <> -1 then Dec(FCurrentRecord, Delta);
  4760.       if FRecordCount > Value then FRecordCount := Value;
  4761.       AdjustFirstRecord(-Delta);
  4762.     end;
  4763.     SetBufListSize(Value + 1);
  4764.     FBufferCount := Value;
  4765.     GetNextRecords;
  4766.     AdjustFirstRecord(GetPriorRecords);
  4767.   end;
  4768. end;
  4769.  
  4770. procedure TDataSet.UpdateBufferCount;
  4771. var
  4772.   I, J, MaxBufferCount: Integer;
  4773.   DataLink: TDataLink;
  4774. begin
  4775.   if IsCursorOpen then
  4776.   begin
  4777.     MaxBufferCount := 1;
  4778.     FFirstDataLink := nil;
  4779.     for I := FDataSources.Count - 1 downto 0 do
  4780.       with TDataSource(FDataSources[I]) do
  4781.         for J := FDataLinks.Count - 1 downto 0 do
  4782.         begin
  4783.           DataLink := FDataLinks[J];
  4784.           DataLink.FNext := FFirstDataLink;
  4785.           FFirstDataLink := DataLink;
  4786.           if DataLink.FBufferCount > MaxBufferCount then
  4787.             MaxBufferCount := DataLink.FBufferCount;
  4788.         end;
  4789.     SetBufferCount(MaxBufferCount);
  4790.   end;
  4791. end;
  4792.  
  4793. procedure TDataSet.SetCurrentRecord(Index: Integer);
  4794. var
  4795.   Buffer: PChar;
  4796. begin
  4797.   if FCurrentRecord <> Index then
  4798.   begin
  4799.     Buffer := FBuffers[Index];
  4800.     case GetBookmarkFlag(Buffer) of
  4801.       bfCurrent,
  4802.       bfInserted: InternalSetToRecord(Buffer);
  4803.       bfBOF: InternalFirst;
  4804.       bfEOF: InternalLast;
  4805.     end;
  4806.     FCurrentRecord := Index;
  4807.   end;
  4808. end;
  4809.  
  4810. function TDataSet.GetBuffer(Index: Integer): PChar;
  4811. begin
  4812.   Result := FBuffers[Index];
  4813. end;
  4814.  
  4815. function TDataSet.GetNextRecord: Boolean;
  4816. var
  4817.   GetMode: TGetMode;
  4818. begin
  4819.   GetMode := gmNext;
  4820.   if FRecordCount > 0 then
  4821.   begin
  4822.     SetCurrentRecord(FRecordCount - 1);
  4823.     if (State = dsInsert) and (FCurrentRecord = FActiveRecord) and
  4824.       (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then GetMode := gmCurrent;
  4825.   end;
  4826.   Result := (GetRecord(FBuffers[FRecordCount], GetMode, True) = grOK);
  4827.   if Result then
  4828.   begin
  4829.     if FRecordCount = 0 then
  4830.       ActivateBuffers
  4831.     else
  4832.       if FRecordCount < FBufferCount then
  4833.         Inc(FRecordCount) else
  4834.         MoveBuffer(0, FRecordCount);
  4835.     FCurrentRecord := FRecordCount - 1;
  4836.     Result := True;
  4837.   end else
  4838.     CursorPosChanged;
  4839. end;
  4840.  
  4841. function TDataSet.GetPriorRecord: Boolean;
  4842. begin
  4843.   if FRecordCount > 0 then SetCurrentRecord(0);
  4844.   Result := (GetRecord(FBuffers[FRecordCount], gmPrior, True) = grOK);
  4845.   if Result then
  4846.   begin
  4847.     if FRecordCount = 0 then
  4848.       ActivateBuffers else
  4849.     begin
  4850.       MoveBuffer(FRecordCount, 0);
  4851.       if FRecordCount < FBufferCount then
  4852.       begin
  4853.         Inc(FRecordCount);
  4854.         Inc(FActiveRecord);
  4855.       end;
  4856.     end;
  4857.     FCurrentRecord := 0;
  4858.   end else
  4859.     CursorPosChanged;
  4860. end;
  4861.  
  4862. procedure TDataSet.Resync(Mode: TResyncMode);
  4863. var
  4864.   Count: Integer;
  4865. begin
  4866.   if rmExact in Mode then
  4867.   begin
  4868.     CursorPosChanged;
  4869.     if GetRecord(FBuffers[FRecordCount], gmCurrent, True) <> grOK then
  4870.       DatabaseError(SRecordNotFound);
  4871.   end else
  4872.     if (GetRecord(FBuffers[FRecordCount], gmCurrent, False) <> grOK) and
  4873.       (GetRecord(FBuffers[FRecordCount], gmNext, False) <> grOK) and
  4874.       (GetRecord(FBuffers[FRecordCount], gmPrior, False) <> grOK) then
  4875.     begin
  4876.       ClearBuffers;
  4877.       DataEvent(deDataSetChange, 0);
  4878.       Exit;
  4879.     end;
  4880.   if rmCenter in Mode then
  4881.     Count := (FBufferCount - 1) div 2 else
  4882.     Count := FActiveRecord;
  4883.   MoveBuffer(FRecordCount, 0);
  4884.   ActivateBuffers;
  4885.   try
  4886.     while (Count > 0) and GetPriorRecord do Dec(Count);
  4887.     GetNextRecords;
  4888.     GetPriorRecords;
  4889.   except
  4890.   end;
  4891.   DataEvent(deDataSetChange, 0);
  4892. end;
  4893.  
  4894. procedure TDataSet.MoveBuffer(CurIndex, NewIndex: Integer);
  4895. var
  4896.   Buffer: PChar;
  4897. begin
  4898.   if CurIndex <> NewIndex then
  4899.   begin
  4900.     Buffer := FBuffers[CurIndex];
  4901.     if CurIndex < NewIndex then
  4902.       Move(FBuffers[CurIndex + 1], FBuffers[CurIndex],
  4903.         (NewIndex - CurIndex) * SizeOf(Pointer))
  4904.     else
  4905.       Move(FBuffers[NewIndex], FBuffers[NewIndex + 1],
  4906.         (CurIndex - NewIndex) * SizeOf(Pointer));
  4907.     FBuffers[NewIndex] := Buffer;
  4908.   end;
  4909. end;
  4910.  
  4911. function TDataSet.ActiveBuffer: PChar;
  4912. begin
  4913.   Result := FBuffers[FActiveRecord];
  4914. end;
  4915.  
  4916. function TDataSet.TempBuffer: PChar;
  4917. begin
  4918.   Result := FBuffers[FRecordCount];
  4919. end;
  4920.  
  4921. procedure TDataSet.ClearBuffers;
  4922. begin
  4923.   FRecordCount := 0;
  4924.   FActiveRecord := 0;
  4925.   FCurrentRecord := -1;
  4926.   FBOF := True;
  4927.   FEOF := True;
  4928. end;
  4929.  
  4930. procedure TDataSet.ActivateBuffers;
  4931. begin
  4932.   FRecordCount := 1;
  4933.   FActiveRecord := 0;
  4934.   FCurrentRecord := 0;
  4935.   FBOF := False;
  4936.   FEOF := False;
  4937. end;
  4938.  
  4939. procedure TDataSet.UpdateCursorPos;
  4940. begin
  4941.   if FRecordCount > 0 then SetCurrentRecord(FActiveRecord);
  4942. end;
  4943.  
  4944. procedure TDataSet.CursorPosChanged;
  4945. begin
  4946.   FCurrentRecord := -1;
  4947. end;
  4948.  
  4949. function TDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  4950. begin
  4951.   Result := False;
  4952. end;
  4953.  
  4954. function TDataSet.GetNextRecords: Integer;
  4955. begin
  4956.   Result := 0;
  4957.   try
  4958.     while (FRecordCount < FBufferCount) and GetNextRecord do Inc(Result);
  4959.   except
  4960.   end;
  4961. end;
  4962.  
  4963. function TDataSet.GetPriorRecords: Integer;
  4964. begin
  4965.   Result := 0;
  4966.   try
  4967.     while (FRecordCount < FBufferCount) and GetPriorRecord do Inc(Result);
  4968.   except
  4969.   end;
  4970. end;
  4971.  
  4972. procedure TDataSet.InitRecord(Buffer: PChar);
  4973. begin
  4974.   InternalInitRecord(Buffer);
  4975.   ClearCalcFields(Buffer);
  4976.   SetBookmarkFlag(Buffer, bfInserted);
  4977. end;
  4978.  
  4979. function TDataSet.IsEmpty: Boolean;
  4980. begin
  4981.   Result := FActiveRecord >= FRecordCount;
  4982. end;
  4983.  
  4984. procedure TDataSet.GetCalcFields(Buffer: PChar);
  4985. var
  4986.   SaveState: TDataSetState;
  4987. begin
  4988.   if (FCalcFieldsSize > 0) or FInternalCalcFields then
  4989.   begin
  4990.     SaveState := FState;
  4991.     FState := dsCalcFields;
  4992.     try
  4993.       CalculateFields(Buffer);
  4994.     finally
  4995.       FState := SaveState;
  4996.     end;
  4997.   end;
  4998. end;
  4999.  
  5000. procedure TDataSet.CalculateFields(Buffer: PChar);
  5001. var
  5002.   I: Integer;
  5003. begin
  5004.   FCalcBuffer := Buffer;
  5005.   ClearCalcFields(CalcBuffer);
  5006.   for I := 0 to FFields.Count - 1 do
  5007.     with TField(FFields[I]) do
  5008.       if FieldKind = fkLookup then CalcLookupValue;
  5009.   DoOnCalcFields;
  5010. end;
  5011.  
  5012. procedure TDataSet.ClearCalcFields(Buffer: PChar);
  5013. begin
  5014. end;
  5015.  
  5016. procedure TDataSet.RefreshInternalCalcFields(Buffer: PChar);
  5017. var
  5018.   I: Integer;
  5019. begin
  5020.   for I := 0 to FieldCount - 1 do
  5021.     with Fields[I] do
  5022.       if (FieldKind = fkInternalCalc) then Value := Value;
  5023. end;
  5024.  
  5025. { Navigation }
  5026.  
  5027. procedure TDataSet.First;
  5028. begin
  5029.   CheckBrowseMode;
  5030.   DoBeforeScroll;
  5031.   ClearBuffers;
  5032.   try
  5033.     InternalFirst;
  5034.     GetNextRecord;
  5035.     GetNextRecords;
  5036.   finally
  5037.     FBOF := True;
  5038.     DataEvent(deDataSetChange, 0);
  5039.     DoAfterScroll;
  5040.   end;
  5041. end;
  5042.  
  5043. procedure TDataSet.Last;
  5044. begin
  5045.   CheckBrowseMode;
  5046.   DoBeforeScroll;
  5047.   ClearBuffers;
  5048.   try
  5049.     InternalLast;
  5050.     GetPriorRecord;
  5051.     GetPriorRecords;
  5052.   finally
  5053.     FEOF := True;
  5054.     DataEvent(deDataSetChange, 0);
  5055.     DoAfterScroll;
  5056.   end;
  5057. end;
  5058.  
  5059. function TDataSet.MoveBy(Distance: Integer): Integer;
  5060. var
  5061.   I, ScrollCount: Integer;
  5062. begin
  5063.   CheckBrowseMode;
  5064.   Result := 0;
  5065.   DoBeforeScroll;
  5066.   if ((Distance > 0) and not FEOF) or ((Distance < 0) and not FBOF) then
  5067.   begin
  5068.     FBOF := False;
  5069.     FEOF := False;
  5070.     ScrollCount := 0;
  5071.     try
  5072.       while Distance > 0 do
  5073.       begin
  5074.         if FActiveRecord < FRecordCount - 1 then Inc(FActiveRecord) else
  5075.         begin
  5076.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  5077.           if GetNextRecord then Dec(ScrollCount, I) else
  5078.           begin
  5079.             FEOF := True;
  5080.             Break;
  5081.           end;
  5082.         end;
  5083.         Dec(Distance);
  5084.         Inc(Result);
  5085.       end;
  5086.       while Distance < 0 do
  5087.       begin
  5088.         if FActiveRecord > 0 then Dec(FActiveRecord) else
  5089.         begin
  5090.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  5091.           if GetPriorRecord then Inc(ScrollCount, I) else
  5092.           begin
  5093.             FBOF := True;
  5094.             Break;
  5095.           end;
  5096.         end;
  5097.         Inc(Distance);
  5098.         Dec(Result);
  5099.       end;
  5100.     finally
  5101.       DataEvent(deDataSetScroll, ScrollCount);
  5102.       DoAfterScroll;
  5103.     end;
  5104.   end;
  5105. end;
  5106.  
  5107. procedure TDataSet.Next;
  5108. begin
  5109.   MoveBy(1);
  5110. end;
  5111.  
  5112. procedure TDataSet.Prior;
  5113. begin
  5114.   MoveBy(-1);
  5115. end;
  5116.  
  5117. procedure TDataSet.Refresh;
  5118. begin
  5119.   CheckBrowseMode;
  5120.   UpdateCursorPos;
  5121.   InternalRefresh;
  5122.   Resync([]);
  5123. end;
  5124.  
  5125. { Editing }
  5126.  
  5127. procedure TDataSet.Edit;
  5128. begin
  5129.   if not (State in [dsEdit, dsInsert]) then
  5130.     if FRecordCount = 0 then Insert else
  5131.     begin
  5132.       CheckBrowseMode;
  5133.       CheckCanModify;
  5134.       DoBeforeEdit;
  5135.       CheckOperation(InternalEdit, FOnEditError);
  5136.       GetCalcFields(ActiveBuffer);
  5137.       SetState(dsEdit);
  5138.       DataEvent(deRecordChange, 0);
  5139.       DoAfterEdit;
  5140.     end;
  5141. end;
  5142.  
  5143. procedure TDataSet.Insert;
  5144. var
  5145.   Buffer: PChar;
  5146.   OldCurrent: TBookmarkStr;
  5147. begin
  5148.   BeginInsertAppend;
  5149.   OldCurrent := Bookmark;
  5150.   MoveBuffer(FRecordCount, FActiveRecord);
  5151.   Buffer := ActiveBuffer;
  5152.   InitRecord(Buffer);
  5153.   if FRecordCount = 0 then
  5154.     SetBookmarkFlag(Buffer, bfBOF) else
  5155.     SetBookmarkData(Buffer, Pointer(OldCurrent));
  5156.   if FRecordCount < FBufferCount then Inc(FRecordCount);
  5157.   EndInsertAppend;
  5158. end;
  5159.  
  5160. procedure TDataSet.Append;
  5161. var
  5162.   Buffer: PChar;
  5163. begin
  5164.   BeginInsertAppend;
  5165.   ClearBuffers;
  5166.   Buffer := FBuffers[0];
  5167.   InitRecord(Buffer);
  5168.   SetBookmarkFlag(Buffer, bfEOF);
  5169.   FRecordCount := 1;
  5170.   FBOF := False;
  5171.   GetPriorRecords;
  5172.   EndInsertAppend;
  5173. end;
  5174.  
  5175. procedure TDataSet.Post;
  5176. begin
  5177.   UpdateRecord;
  5178.   case State of
  5179.     dsEdit, dsInsert:
  5180.       begin
  5181.         DataEvent(deCheckBrowseMode, 0);
  5182.         CheckRequiredFields;
  5183.         DoBeforePost;
  5184.         CheckOperation(InternalPost, FOnPostError);
  5185.         FreeFieldBuffers;
  5186.         SetState(dsBrowse);
  5187.         Resync([]);
  5188.         DoAfterPost;
  5189.       end;
  5190.   end;
  5191. end;
  5192.  
  5193. procedure TDataSet.Cancel;
  5194. begin
  5195.   case State of
  5196.     dsEdit, dsInsert:
  5197.       begin
  5198.         DataEvent(deCheckBrowseMode, 0);
  5199.         DoBeforeCancel;
  5200.         UpdateCursorPos;
  5201.         if State = dsEdit then InternalCancel;
  5202.         FreeFieldBuffers;
  5203.         SetState(dsBrowse);
  5204.         Resync([]);
  5205.         DoAfterCancel;
  5206.       end;
  5207.   end;
  5208. end;
  5209.  
  5210. procedure TDataSet.Delete;
  5211. begin
  5212.   CheckActive;
  5213.   if State in [dsInsert, dsSetKey] then Cancel else
  5214.   begin
  5215.     if FRecordCount = 0 then DatabaseError(SDataSetEmpty);
  5216.     DataEvent(deCheckBrowseMode, 0);
  5217.     DoBeforeDelete;
  5218.     DoBeforeScroll;
  5219.     CheckOperation(InternalDelete, FOnDeleteError);
  5220.     FreeFieldBuffers;
  5221.     SetState(dsBrowse);
  5222.     Resync([]);
  5223.     DoAfterDelete;
  5224.     DoAfterScroll;
  5225.   end;
  5226. end;
  5227.  
  5228. procedure TDataSet.BeginInsertAppend;
  5229. begin
  5230.   CheckBrowseMode;
  5231.   CheckCanModify;
  5232.   DoBeforeInsert;
  5233.   DoBeforeScroll;
  5234. end;
  5235.  
  5236. procedure TDataSet.EndInsertAppend;
  5237. begin
  5238.   SetState(dsInsert);
  5239.   try
  5240.     DoOnNewRecord;
  5241.   except
  5242.     UpdateCursorPos;
  5243.     FreeFieldBuffers;
  5244.     SetState(dsBrowse);
  5245.     Resync([]);
  5246.     raise;
  5247.   end;
  5248.   FModified := False;
  5249.   DataEvent(deDataSetChange, 0);
  5250.   DoAfterInsert;
  5251.   DoAfterScroll;
  5252. end;
  5253.  
  5254. procedure TDataSet.AddRecord(const Values: array of const; Append: Boolean);
  5255. var
  5256.   Buffer: PChar;
  5257. begin
  5258.   BeginInsertAppend;
  5259.   if not Append then UpdateCursorPos;
  5260.   DisableControls;
  5261.   try
  5262.     MoveBuffer(FRecordCount, FActiveRecord);
  5263.     try
  5264.       Buffer := ActiveBuffer;
  5265.       InitRecord(Buffer);
  5266.       FState := dsInsert;
  5267.       try
  5268.         DoOnNewRecord;
  5269.         DoAfterInsert;
  5270.         SetFields(Values);
  5271.         DoBeforePost;
  5272.         InternalAddRecord(Buffer, Append);
  5273.       finally
  5274.         FreeFieldBuffers;
  5275.         FState := dsBrowse;
  5276.         FModified := False;
  5277.       end;
  5278.     except
  5279.       MoveBuffer(FActiveRecord, FRecordCount);
  5280.       raise;
  5281.     end;
  5282.     Resync([]);
  5283.     DoAfterPost;
  5284.   finally
  5285.     EnableControls;
  5286.   end;
  5287. end;
  5288.  
  5289. procedure TDataSet.InsertRecord(const Values: array of const);
  5290. begin
  5291.   AddRecord(Values, False);
  5292. end;
  5293.  
  5294. procedure TDataSet.AppendRecord(const Values: array of const);
  5295. begin
  5296.   AddRecord(Values, True);
  5297. end;
  5298.  
  5299. procedure TDataSet.CheckOperation(Operation: TDataOperation;
  5300.   ErrorEvent: TDataSetErrorEvent);
  5301. var
  5302.   Done: Boolean;
  5303.   Action: TDataAction;
  5304. begin
  5305.   Done := False;
  5306.   repeat
  5307.     try
  5308.       UpdateCursorPos;
  5309.       Operation;
  5310.       Done := True;
  5311.     except
  5312.       on E: EDatabaseError do
  5313.       begin
  5314.         Action := daFail;
  5315.         if Assigned(ErrorEvent) then ErrorEvent(Self, E, Action);
  5316.         if Action = daFail then raise;
  5317.         if Action = daAbort then SysUtils.Abort;
  5318.       end;
  5319.     end;
  5320.   until Done;
  5321. end;
  5322.  
  5323. procedure TDataSet.SetFields(const Values: array of const);
  5324. var
  5325.   I: Integer;
  5326. begin
  5327.   for I := 0 to High(Values) do Fields[I].AssignValue(Values[I]);
  5328. end;
  5329.  
  5330. procedure TDataSet.ClearFields;
  5331. begin
  5332.   if not (State in dsEditModes) then DatabaseError(SNotEditing);
  5333.   DataEvent(deCheckBrowseMode, 0);
  5334.   InternalInitRecord(ActiveBuffer);
  5335.   if State <> dsSetKey then GetCalcFields(ActiveBuffer);
  5336.   DataEvent(deRecordChange, 0);
  5337. end;
  5338.  
  5339. procedure TDataSet.CheckRequiredFields;
  5340. var
  5341.   I: Integer;
  5342. begin
  5343.   for I := 0 to FFields.Count - 1 do
  5344.     with TField(FFields[I]) do
  5345.       if Required and not ReadOnly and (FieldKind = fkData) and IsNull then
  5346.       begin
  5347.         FocusControl;
  5348.         DatabaseErrorFmt(SFieldRequired, [DisplayName]);
  5349.       end;
  5350. end;
  5351.  
  5352. { Bookmarks }
  5353.  
  5354. function TDataset.BookmarkAvailable: Boolean;
  5355. begin
  5356.   Result := (State in [dsBrowse, dsEdit, dsInsert]) and not IsEmpty
  5357.     and (GetBookmarkFlag(ActiveBuffer) = bfCurrent);
  5358. end;
  5359.  
  5360. function TDataSet.GetBookmark: TBookmark;
  5361. begin
  5362.   if BookmarkAvailable then
  5363.   begin
  5364.     Result := StrAlloc(FBookmarkSize);
  5365.     GetBookmarkData(ActiveBuffer, Result);
  5366.   end else
  5367.     Result := nil;
  5368. end;
  5369.  
  5370. function TDataset.GetBookmarkStr: TBookmarkStr;
  5371. begin
  5372.   if BookmarkAvailable then
  5373.   begin
  5374.     SetLength(Result, BookmarkSize);
  5375.     GetBookmarkData(ActiveBuffer, Pointer(Result));
  5376.   end else
  5377.     Result := '';
  5378. end;
  5379.  
  5380. procedure TDataSet.GotoBookmark(Bookmark: TBookmark);
  5381. begin
  5382.   if Bookmark <> nil then
  5383.   begin
  5384.     CheckBrowseMode;
  5385.     DoBeforeScroll;
  5386.     InternalGotoBookmark(Bookmark);
  5387.     Resync([rmExact, rmCenter]);
  5388.     DoAfterScroll;
  5389.   end;
  5390. end;
  5391.  
  5392. procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr);
  5393. begin
  5394.   GotoBookmark(Pointer(Value));
  5395. end;
  5396.  
  5397. function TDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  5398. begin
  5399.   Result := False;
  5400. end;
  5401.  
  5402. function TDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  5403. begin
  5404.   Result := 0;
  5405. end;
  5406.  
  5407. procedure TDataSet.FreeBookmark(Bookmark: TBookmark);
  5408. begin
  5409.   StrDispose(Bookmark);
  5410. end;
  5411.  
  5412. procedure TDataSet.InternalCancel;
  5413. begin
  5414. end;
  5415.  
  5416. procedure TDataSet.InternalEdit;
  5417. begin
  5418. end;
  5419.  
  5420. procedure TDataSet.InternalRefresh;
  5421. begin
  5422. end;
  5423.  
  5424. procedure TDataSet.Translate(Src, Dest: PChar; ToOem: Boolean);
  5425. begin
  5426.   if (Src <> nil) and (Src <> Dest) then
  5427.     StrCopy(Dest, Src);
  5428. end;
  5429.  
  5430. { Filter / Locate / Find }
  5431.  
  5432. function TDataSet.FindRecord(Restart, GoForward: Boolean): Boolean;
  5433. begin
  5434.   Result := False;
  5435. end;
  5436.  
  5437. function TDataSet.FindFirst: Boolean;
  5438. begin
  5439.   Result := FindRecord(True, True);
  5440. end;
  5441.  
  5442. function TDataSet.FindLast: Boolean;
  5443. begin
  5444.   Result := FindRecord(True, False);
  5445. end;
  5446.  
  5447. function TDataSet.FindNext: Boolean;
  5448. begin
  5449.   Result := FindRecord(False, True);
  5450. end;
  5451.  
  5452. function TDataSet.FindPrior: Boolean;
  5453. begin
  5454.   Result := FindRecord(False, False);
  5455. end;
  5456.  
  5457. procedure TDataSet.SetFiltered(Value: Boolean);
  5458. begin
  5459.   FFiltered := Value;
  5460. end;
  5461.  
  5462. procedure TDataSet.SetFilterOptions(Value: TFilterOptions);
  5463. begin
  5464.   FFilterOptions := Value;
  5465. end;
  5466.  
  5467. procedure TDataSet.SetFilterText(const Value: string);
  5468. begin
  5469.   FFilterText := Value;
  5470. end;
  5471.  
  5472. procedure TDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
  5473. begin
  5474.   FOnFilterRecord := Value;
  5475. end;
  5476.  
  5477. function TDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  5478.   Options: TLocateOptions): Boolean;
  5479. begin
  5480.   Result := False;
  5481. end;
  5482.  
  5483. function TDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  5484.   const ResultFields: string): Variant;
  5485. begin
  5486.   Result := False;
  5487. end;
  5488.  
  5489. { Informational }
  5490.  
  5491. procedure TDataSet.CheckBrowseMode;
  5492. begin
  5493.   CheckActive;
  5494.   DataEvent(deCheckBrowseMode, 0);
  5495.   case State of
  5496.     dsEdit, dsInsert:
  5497.       begin
  5498.         UpdateRecord;
  5499.         if Modified then Post else Cancel;
  5500.       end;
  5501.     dsSetKey:
  5502.       Post;
  5503.   end;
  5504. end;
  5505.  
  5506. function TDataSet.GetCanModify: Boolean;
  5507. begin
  5508.   Result := True;
  5509. end;
  5510.  
  5511. procedure TDataSet.CheckCanModify;
  5512. begin
  5513.   if not CanModify then DatabaseError(SDataSetReadOnly);
  5514. end;
  5515.  
  5516. procedure TDataSet.GetFieldList(List: TList; const FieldNames: string);
  5517. var
  5518.   Pos: Integer;
  5519. begin
  5520.   Pos := 1;
  5521.   while Pos <= Length(FieldNames) do
  5522.     List.Add(FieldByName(ExtractFieldName(FieldNames, Pos)));
  5523. end;
  5524.  
  5525. function TDataSet.GetRecordCount: Longint;
  5526. begin
  5527.   Result := -1;
  5528. end;
  5529.  
  5530. function TDataSet.GetRecNo: Integer;
  5531. begin
  5532.   Result := -1;
  5533. end;
  5534.  
  5535. procedure TDataSet.SetRecNo(Value: Integer);
  5536. begin
  5537. end;
  5538.  
  5539. { Event Handler Helpers }
  5540.  
  5541. procedure TDataSet.DoAfterCancel;
  5542. begin
  5543.   if Assigned(FAfterCancel) then FAfterCancel(Self);
  5544. end;
  5545.  
  5546. procedure TDataSet.DoAfterClose;
  5547. begin
  5548.   if Assigned(FAfterClose) then FAfterClose(Self);
  5549. end;
  5550.  
  5551. procedure TDataSet.DoAfterDelete;
  5552. begin
  5553.   if Assigned(FAfterDelete) then FAfterDelete(Self);
  5554. end;
  5555.  
  5556. procedure TDataSet.DoAfterEdit;
  5557. begin
  5558.   if Assigned(FAfterEdit) then FAfterEdit(Self);
  5559. end;
  5560.  
  5561. procedure TDataSet.DoAfterInsert;
  5562. begin
  5563.   if Assigned(FAfterInsert) then FAfterInsert(Self);
  5564. end;
  5565.  
  5566. procedure TDataSet.DoAfterOpen;
  5567. begin
  5568.   if Assigned(FAfterOpen) then FAfterOpen(Self);
  5569. end;
  5570.  
  5571. procedure TDataSet.DoAfterPost;
  5572. begin
  5573.   if Assigned(FAfterPost) then FAfterPost(Self);
  5574. end;
  5575.  
  5576. procedure TDataSet.DoAfterScroll;
  5577. begin
  5578.   if Assigned(FAfterScroll) then FAfterScroll(Self);
  5579. end;
  5580.  
  5581. procedure TDataSet.DoBeforeCancel;
  5582. begin
  5583.   if Assigned(FBeforeCancel) then FBeforeCancel(Self);
  5584. end;
  5585.  
  5586. procedure TDataSet.DoBeforeClose;
  5587. begin
  5588.   if Assigned(FBeforeClose) then FBeforeClose(Self);
  5589. end;
  5590.  
  5591. procedure TDataSet.DoBeforeDelete;
  5592. begin
  5593.   if Assigned(FBeforeDelete) then FBeforeDelete(Self);
  5594. end;
  5595.  
  5596. procedure TDataSet.DoBeforeEdit;
  5597. begin
  5598.   if Assigned(FBeforeEdit) then FBeforeEdit(Self);
  5599. end;
  5600.  
  5601. procedure TDataSet.DoBeforeInsert;
  5602. begin
  5603.   if Assigned(FBeforeInsert) then FBeforeInsert(Self);
  5604. end;
  5605.  
  5606. procedure TDataSet.DoBeforeOpen;
  5607. begin
  5608.   if Assigned(FBeforeOpen) then FBeforeOpen(Self);
  5609. end;
  5610.  
  5611. procedure TDataSet.DoBeforePost;
  5612. begin
  5613.   if Assigned(FBeforePost) then FBeforePost(Self);
  5614. end;
  5615.  
  5616. procedure TDataSet.DoBeforeScroll;
  5617. begin
  5618.   if Assigned(FBeforeScroll) then FBeforeScroll(Self);
  5619. end;
  5620.  
  5621. procedure TDataSet.DoOnCalcFields;
  5622. begin
  5623.   if Assigned(FOnCalcFields) then FOnCalcFields(Self);
  5624. end;
  5625.  
  5626. procedure TDataSet.DoOnNewRecord;
  5627. begin
  5628.   if Assigned(FOnNewRecord) then FOnNewRecord(Self);
  5629. end;
  5630.  
  5631. end.
  5632.